R version 2.9.0 (2009-04-17) Copyright (C) 2009 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(10.9,96.8,10,114.1,9.2,110.3,9.2,103.9,9.5,101.6,9.6,94.6,9.5,95.9,9.1,104.7,8.9,102.8,9,98.1,10.1,113.9,10.3,80.9,10.2,95.7,9.6,113.2,9.2,105.9,9.3,108.8,9.4,102.3,9.4,99,9.2,100.7,9,115.5,9,100.7,9,109.9,9.8,114.6,10,85.4,9.8,100.5,9.3,114.8,9,116.5,9,112.9,9.1,102,9.1,106,9.1,105.3,9.2,118.8,8.8,106.1,8.3,109.3,8.4,117.2,8.1,92.5,7.7,104.2,7.9,112.5,7.9,122.4,8,113.3,7.9,100,7.6,110.7,7.1,112.8,6.8,109.8,6.5,117.3,6.9,109.1,8.2,115.9,8.7,96,8.3,99.8,7.9,116.8,7.5,115.7,7.8,99.4,8.3,94.3,8.4,91,8.2,93.2,7.7,103.1,7.2,94.1,7.3,91.8,8.1,102.7,8.5,82.6),dim=c(2,60),dimnames=list(c('Y','X'),1:60)) > y <- array(NA,dim=c(2,60),dimnames=list(c('Y','X'),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 = '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 Y X M1 M2 M3 M4 M5 M6 M7 M8 M9 M10 M11 t 1 10.9 96.8 1 0 0 0 0 0 0 0 0 0 0 1 2 10.0 114.1 0 1 0 0 0 0 0 0 0 0 0 2 3 9.2 110.3 0 0 1 0 0 0 0 0 0 0 0 3 4 9.2 103.9 0 0 0 1 0 0 0 0 0 0 0 4 5 9.5 101.6 0 0 0 0 1 0 0 0 0 0 0 5 6 9.6 94.6 0 0 0 0 0 1 0 0 0 0 0 6 7 9.5 95.9 0 0 0 0 0 0 1 0 0 0 0 7 8 9.1 104.7 0 0 0 0 0 0 0 1 0 0 0 8 9 8.9 102.8 0 0 0 0 0 0 0 0 1 0 0 9 10 9.0 98.1 0 0 0 0 0 0 0 0 0 1 0 10 11 10.1 113.9 0 0 0 0 0 0 0 0 0 0 1 11 12 10.3 80.9 0 0 0 0 0 0 0 0 0 0 0 12 13 10.2 95.7 1 0 0 0 0 0 0 0 0 0 0 13 14 9.6 113.2 0 1 0 0 0 0 0 0 0 0 0 14 15 9.2 105.9 0 0 1 0 0 0 0 0 0 0 0 15 16 9.3 108.8 0 0 0 1 0 0 0 0 0 0 0 16 17 9.4 102.3 0 0 0 0 1 0 0 0 0 0 0 17 18 9.4 99.0 0 0 0 0 0 1 0 0 0 0 0 18 19 9.2 100.7 0 0 0 0 0 0 1 0 0 0 0 19 20 9.0 115.5 0 0 0 0 0 0 0 1 0 0 0 20 21 9.0 100.7 0 0 0 0 0 0 0 0 1 0 0 21 22 9.0 109.9 0 0 0 0 0 0 0 0 0 1 0 22 23 9.8 114.6 0 0 0 0 0 0 0 0 0 0 1 23 24 10.0 85.4 0 0 0 0 0 0 0 0 0 0 0 24 25 9.8 100.5 1 0 0 0 0 0 0 0 0 0 0 25 26 9.3 114.8 0 1 0 0 0 0 0 0 0 0 0 26 27 9.0 116.5 0 0 1 0 0 0 0 0 0 0 0 27 28 9.0 112.9 0 0 0 1 0 0 0 0 0 0 0 28 29 9.1 102.0 0 0 0 0 1 0 0 0 0 0 0 29 30 9.1 106.0 0 0 0 0 0 1 0 0 0 0 0 30 31 9.1 105.3 0 0 0 0 0 0 1 0 0 0 0 31 32 9.2 118.8 0 0 0 0 0 0 0 1 0 0 0 32 33 8.8 106.1 0 0 0 0 0 0 0 0 1 0 0 33 34 8.3 109.3 0 0 0 0 0 0 0 0 0 1 0 34 35 8.4 117.2 0 0 0 0 0 0 0 0 0 0 1 35 36 8.1 92.5 0 0 0 0 0 0 0 0 0 0 0 36 37 7.7 104.2 1 0 0 0 0 0 0 0 0 0 0 37 38 7.9 112.5 0 1 0 0 0 0 0 0 0 0 0 38 39 7.9 122.4 0 0 1 0 0 0 0 0 0 0 0 39 40 8.0 113.3 0 0 0 1 0 0 0 0 0 0 0 40 41 7.9 100.0 0 0 0 0 1 0 0 0 0 0 0 41 42 7.6 110.7 0 0 0 0 0 1 0 0 0 0 0 42 43 7.1 112.8 0 0 0 0 0 0 1 0 0 0 0 43 44 6.8 109.8 0 0 0 0 0 0 0 1 0 0 0 44 45 6.5 117.3 0 0 0 0 0 0 0 0 1 0 0 45 46 6.9 109.1 0 0 0 0 0 0 0 0 0 1 0 46 47 8.2 115.9 0 0 0 0 0 0 0 0 0 0 1 47 48 8.7 96.0 0 0 0 0 0 0 0 0 0 0 0 48 49 8.3 99.8 1 0 0 0 0 0 0 0 0 0 0 49 50 7.9 116.8 0 1 0 0 0 0 0 0 0 0 0 50 51 7.5 115.7 0 0 1 0 0 0 0 0 0 0 0 51 52 7.8 99.4 0 0 0 1 0 0 0 0 0 0 0 52 53 8.3 94.3 0 0 0 0 1 0 0 0 0 0 0 53 54 8.4 91.0 0 0 0 0 0 1 0 0 0 0 0 54 55 8.2 93.2 0 0 0 0 0 0 1 0 0 0 0 55 56 7.7 103.1 0 0 0 0 0 0 0 1 0 0 0 56 57 7.2 94.1 0 0 0 0 0 0 0 0 1 0 0 57 58 7.3 91.8 0 0 0 0 0 0 0 0 0 1 0 58 59 8.1 102.7 0 0 0 0 0 0 0 0 0 0 1 59 60 8.5 82.6 0 0 0 0 0 0 0 0 0 0 0 60 > k <- length(x[1,]) > df <- as.data.frame(x) > (mylm <- lm(df)) Call: lm(formula = df) Coefficients: (Intercept) X M1 M2 M3 M4 13.07654 -0.02753 0.11505 0.12769 -0.21260 -0.24853 M5 M6 M7 M8 M9 M10 -0.23529 -0.20623 -0.32688 -0.30162 -0.70874 -0.66115 M11 t 0.45568 -0.04301 > (mysum <- summary(mylm)) Call: lm(formula = df) Residuals: Min 1Q Median 3Q Max -1.05987 -0.31374 0.03444 0.33153 1.07179 Coefficients: Estimate Std. Error t value Pr(>|t|) (Intercept) 13.076538 1.018147 12.843 < 2e-16 *** X -0.027529 0.011268 -2.443 0.0185 * M1 0.115053 0.345397 0.333 0.7406 M2 0.127693 0.438520 0.291 0.7722 M3 -0.212602 0.437244 -0.486 0.6291 M4 -0.248532 0.390101 -0.637 0.5272 M5 -0.235295 0.346709 -0.679 0.5008 M6 -0.206230 0.347442 -0.594 0.5557 M7 -0.326883 0.353633 -0.924 0.3601 M8 -0.301620 0.407789 -0.740 0.4633 M9 -0.708740 0.367501 -1.929 0.0600 . M10 -0.661148 0.364181 -1.815 0.0760 . M11 0.455677 0.425685 1.070 0.2900 t -0.043008 0.003792 -11.342 6.4e-15 *** --- Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1 Residual standard error: 0.4984 on 46 degrees of freedom Multiple R-squared: 0.7859, Adjusted R-squared: 0.7254 F-statistic: 12.99 on 13 and 46 DF, p-value: 2.499e-11 > 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,] 1.318216e-01 2.636432e-01 0.8681784 [2,] 5.489896e-02 1.097979e-01 0.9451010 [3,] 2.341692e-02 4.683383e-02 0.9765831 [4,] 7.780363e-03 1.556073e-02 0.9922196 [5,] 5.202778e-03 1.040556e-02 0.9947972 [6,] 1.808220e-03 3.616441e-03 0.9981918 [7,] 5.963077e-04 1.192615e-03 0.9994037 [8,] 2.065217e-04 4.130433e-04 0.9997935 [9,] 3.459605e-04 6.919210e-04 0.9996540 [10,] 1.159561e-04 2.319123e-04 0.9998840 [11,] 3.832931e-05 7.665862e-05 0.9999617 [12,] 1.211343e-05 2.422687e-05 0.9999879 [13,] 3.348582e-06 6.697164e-06 0.9999967 [14,] 1.013843e-06 2.027686e-06 0.9999990 [15,] 3.443292e-07 6.886584e-07 0.9999997 [16,] 1.189127e-05 2.378254e-05 0.9999881 [17,] 1.131800e-04 2.263601e-04 0.9998868 [18,] 5.893115e-03 1.178623e-02 0.9941069 [19,] 1.940240e-01 3.880480e-01 0.8059760 [20,] 6.427493e-01 7.145015e-01 0.3572507 [21,] 8.738495e-01 2.523011e-01 0.1261505 [22,] 8.303309e-01 3.393382e-01 0.1696691 [23,] 8.111038e-01 3.777925e-01 0.1888962 [24,] 8.116284e-01 3.767431e-01 0.1883716 [25,] 7.011486e-01 5.977029e-01 0.2988514 [26,] 6.005763e-01 7.988475e-01 0.3994237 [27,] 6.284311e-01 7.431378e-01 0.3715689 > postscript(file="/var/www/html/rcomp/tmp/1yhxc1258713084.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/2ic8i1258713084.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/3nbuu1258713084.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/4z61v1258713084.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/5gvj81258713084.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 0.41622342 0.02284356 -0.49846311 -0.59571021 -0.32925600 -0.40801528 7 8 9 10 11 12 -0.30856586 -0.44856586 -0.25074180 -0.28471181 0.17642893 -0.03334195 13 14 15 16 17 18 0.20204214 0.11416808 -0.10349004 0.15528243 0.10611490 0.02921287 19 20 21 22 23 24 0.03967388 0.26484780 0.30754794 0.55623085 0.41179983 0.30663910 25 26 27 28 29 30 0.45028189 0.37431507 0.50441783 0.48425189 0.31395681 0.43801638 31 32 33 34 35 36 0.58240783 1.07179407 0.77230507 0.35581406 -0.40052420 -0.88180449 37 38 39 40 41 42 -1.03176025 -0.57290099 0.08293946 0.01136409 -0.42500055 -0.41649677 43 44 45 46 47 48 -0.69502416 -1.05986620 -0.70326967 -0.53359112 -0.12021127 0.33064758 49 50 51 52 53 54 -0.03678719 0.06157427 0.01459586 -0.05518821 0.33418484 0.35728280 55 56 57 58 59 60 0.38150831 0.17179020 -0.12584154 -0.09374198 -0.06749328 0.27785977 > postscript(file="/var/www/html/rcomp/tmp/6417e1258713084.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 0.41622342 NA 1 0.02284356 0.41622342 2 -0.49846311 0.02284356 3 -0.59571021 -0.49846311 4 -0.32925600 -0.59571021 5 -0.40801528 -0.32925600 6 -0.30856586 -0.40801528 7 -0.44856586 -0.30856586 8 -0.25074180 -0.44856586 9 -0.28471181 -0.25074180 10 0.17642893 -0.28471181 11 -0.03334195 0.17642893 12 0.20204214 -0.03334195 13 0.11416808 0.20204214 14 -0.10349004 0.11416808 15 0.15528243 -0.10349004 16 0.10611490 0.15528243 17 0.02921287 0.10611490 18 0.03967388 0.02921287 19 0.26484780 0.03967388 20 0.30754794 0.26484780 21 0.55623085 0.30754794 22 0.41179983 0.55623085 23 0.30663910 0.41179983 24 0.45028189 0.30663910 25 0.37431507 0.45028189 26 0.50441783 0.37431507 27 0.48425189 0.50441783 28 0.31395681 0.48425189 29 0.43801638 0.31395681 30 0.58240783 0.43801638 31 1.07179407 0.58240783 32 0.77230507 1.07179407 33 0.35581406 0.77230507 34 -0.40052420 0.35581406 35 -0.88180449 -0.40052420 36 -1.03176025 -0.88180449 37 -0.57290099 -1.03176025 38 0.08293946 -0.57290099 39 0.01136409 0.08293946 40 -0.42500055 0.01136409 41 -0.41649677 -0.42500055 42 -0.69502416 -0.41649677 43 -1.05986620 -0.69502416 44 -0.70326967 -1.05986620 45 -0.53359112 -0.70326967 46 -0.12021127 -0.53359112 47 0.33064758 -0.12021127 48 -0.03678719 0.33064758 49 0.06157427 -0.03678719 50 0.01459586 0.06157427 51 -0.05518821 0.01459586 52 0.33418484 -0.05518821 53 0.35728280 0.33418484 54 0.38150831 0.35728280 55 0.17179020 0.38150831 56 -0.12584154 0.17179020 57 -0.09374198 -0.12584154 58 -0.06749328 -0.09374198 59 0.27785977 -0.06749328 60 NA 0.27785977 > dum1 <- dum[2:length(myerror),] > dum1 lag(myerror, k = 1) myerror [1,] 0.02284356 0.41622342 [2,] -0.49846311 0.02284356 [3,] -0.59571021 -0.49846311 [4,] -0.32925600 -0.59571021 [5,] -0.40801528 -0.32925600 [6,] -0.30856586 -0.40801528 [7,] -0.44856586 -0.30856586 [8,] -0.25074180 -0.44856586 [9,] -0.28471181 -0.25074180 [10,] 0.17642893 -0.28471181 [11,] -0.03334195 0.17642893 [12,] 0.20204214 -0.03334195 [13,] 0.11416808 0.20204214 [14,] -0.10349004 0.11416808 [15,] 0.15528243 -0.10349004 [16,] 0.10611490 0.15528243 [17,] 0.02921287 0.10611490 [18,] 0.03967388 0.02921287 [19,] 0.26484780 0.03967388 [20,] 0.30754794 0.26484780 [21,] 0.55623085 0.30754794 [22,] 0.41179983 0.55623085 [23,] 0.30663910 0.41179983 [24,] 0.45028189 0.30663910 [25,] 0.37431507 0.45028189 [26,] 0.50441783 0.37431507 [27,] 0.48425189 0.50441783 [28,] 0.31395681 0.48425189 [29,] 0.43801638 0.31395681 [30,] 0.58240783 0.43801638 [31,] 1.07179407 0.58240783 [32,] 0.77230507 1.07179407 [33,] 0.35581406 0.77230507 [34,] -0.40052420 0.35581406 [35,] -0.88180449 -0.40052420 [36,] -1.03176025 -0.88180449 [37,] -0.57290099 -1.03176025 [38,] 0.08293946 -0.57290099 [39,] 0.01136409 0.08293946 [40,] -0.42500055 0.01136409 [41,] -0.41649677 -0.42500055 [42,] -0.69502416 -0.41649677 [43,] -1.05986620 -0.69502416 [44,] -0.70326967 -1.05986620 [45,] -0.53359112 -0.70326967 [46,] -0.12021127 -0.53359112 [47,] 0.33064758 -0.12021127 [48,] -0.03678719 0.33064758 [49,] 0.06157427 -0.03678719 [50,] 0.01459586 0.06157427 [51,] -0.05518821 0.01459586 [52,] 0.33418484 -0.05518821 [53,] 0.35728280 0.33418484 [54,] 0.38150831 0.35728280 [55,] 0.17179020 0.38150831 [56,] -0.12584154 0.17179020 [57,] -0.09374198 -0.12584154 [58,] -0.06749328 -0.09374198 [59,] 0.27785977 -0.06749328 > z <- as.data.frame(dum1) > z lag(myerror, k = 1) myerror 1 0.02284356 0.41622342 2 -0.49846311 0.02284356 3 -0.59571021 -0.49846311 4 -0.32925600 -0.59571021 5 -0.40801528 -0.32925600 6 -0.30856586 -0.40801528 7 -0.44856586 -0.30856586 8 -0.25074180 -0.44856586 9 -0.28471181 -0.25074180 10 0.17642893 -0.28471181 11 -0.03334195 0.17642893 12 0.20204214 -0.03334195 13 0.11416808 0.20204214 14 -0.10349004 0.11416808 15 0.15528243 -0.10349004 16 0.10611490 0.15528243 17 0.02921287 0.10611490 18 0.03967388 0.02921287 19 0.26484780 0.03967388 20 0.30754794 0.26484780 21 0.55623085 0.30754794 22 0.41179983 0.55623085 23 0.30663910 0.41179983 24 0.45028189 0.30663910 25 0.37431507 0.45028189 26 0.50441783 0.37431507 27 0.48425189 0.50441783 28 0.31395681 0.48425189 29 0.43801638 0.31395681 30 0.58240783 0.43801638 31 1.07179407 0.58240783 32 0.77230507 1.07179407 33 0.35581406 0.77230507 34 -0.40052420 0.35581406 35 -0.88180449 -0.40052420 36 -1.03176025 -0.88180449 37 -0.57290099 -1.03176025 38 0.08293946 -0.57290099 39 0.01136409 0.08293946 40 -0.42500055 0.01136409 41 -0.41649677 -0.42500055 42 -0.69502416 -0.41649677 43 -1.05986620 -0.69502416 44 -0.70326967 -1.05986620 45 -0.53359112 -0.70326967 46 -0.12021127 -0.53359112 47 0.33064758 -0.12021127 48 -0.03678719 0.33064758 49 0.06157427 -0.03678719 50 0.01459586 0.06157427 51 -0.05518821 0.01459586 52 0.33418484 -0.05518821 53 0.35728280 0.33418484 54 0.38150831 0.35728280 55 0.17179020 0.38150831 56 -0.12584154 0.17179020 57 -0.09374198 -0.12584154 58 -0.06749328 -0.09374198 59 0.27785977 -0.06749328 > 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/7tzmm1258713084.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/86eam1258713084.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/9ldjd1258713084.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/103wq91258713084.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/11elyx1258713084.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/12t2t11258713084.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/13e7ed1258713084.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/141bf41258713084.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/15xwa71258713084.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/16ub471258713084.tab") + } > > system("convert tmp/1yhxc1258713084.ps tmp/1yhxc1258713084.png") > system("convert tmp/2ic8i1258713084.ps tmp/2ic8i1258713084.png") > system("convert tmp/3nbuu1258713084.ps tmp/3nbuu1258713084.png") > system("convert tmp/4z61v1258713084.ps tmp/4z61v1258713084.png") > system("convert tmp/5gvj81258713084.ps tmp/5gvj81258713084.png") > system("convert tmp/6417e1258713084.ps tmp/6417e1258713084.png") > system("convert tmp/7tzmm1258713084.ps tmp/7tzmm1258713084.png") > system("convert tmp/86eam1258713084.ps tmp/86eam1258713084.png") > system("convert tmp/9ldjd1258713084.ps tmp/9ldjd1258713084.png") > system("convert tmp/103wq91258713084.ps tmp/103wq91258713084.png") > > > proc.time() user system elapsed 2.376 1.547 2.859