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(8.6,1.59,8.5,1.26,8.3,1.13,7.8,1.92,7.8,2.61,8,2.26,8.6,2.41,8.9,2.26,8.9,2.03,8.6,2.86,8.3,2.55,8.3,2.27,8.3,2.26,8.4,2.57,8.5,3.07,8.4,2.76,8.6,2.51,8.5,2.87,8.5,3.14,8.5,3.11,8.5,3.16,8.5,2.47,8.5,2.57,8.5,2.89,8.5,2.63,8.5,2.38,8.5,1.69,8.5,1.96,8.6,2.19,8.4,1.87,8.1,1.6,8,1.63,8,1.22,8,1.21,8,1.49,7.9,1.64,7.8,1.66,7.8,1.77,7.9,1.82,8.1,1.78,8,1.28,7.6,1.29,7.3,1.37,7,1.12,6.8,1.51,7,2.24,7.1,2.94,7.2,3.09,7.1,3.46,6.9,3.64,6.7,4.39,6.7,4.15,6.6,5.21,6.9,5.8,7.3,5.91,7.5,5.39,7.3,5.46,7.1,4.72,6.9,3.14,7.1,2.63),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 = '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 Y X M1 M2 M3 M4 M5 M6 M7 M8 M9 M10 M11 1 8.6 1.59 1 0 0 0 0 0 0 0 0 0 0 2 8.5 1.26 0 1 0 0 0 0 0 0 0 0 0 3 8.3 1.13 0 0 1 0 0 0 0 0 0 0 0 4 7.8 1.92 0 0 0 1 0 0 0 0 0 0 0 5 7.8 2.61 0 0 0 0 1 0 0 0 0 0 0 6 8.0 2.26 0 0 0 0 0 1 0 0 0 0 0 7 8.6 2.41 0 0 0 0 0 0 1 0 0 0 0 8 8.9 2.26 0 0 0 0 0 0 0 1 0 0 0 9 8.9 2.03 0 0 0 0 0 0 0 0 1 0 0 10 8.6 2.86 0 0 0 0 0 0 0 0 0 1 0 11 8.3 2.55 0 0 0 0 0 0 0 0 0 0 1 12 8.3 2.27 0 0 0 0 0 0 0 0 0 0 0 13 8.3 2.26 1 0 0 0 0 0 0 0 0 0 0 14 8.4 2.57 0 1 0 0 0 0 0 0 0 0 0 15 8.5 3.07 0 0 1 0 0 0 0 0 0 0 0 16 8.4 2.76 0 0 0 1 0 0 0 0 0 0 0 17 8.6 2.51 0 0 0 0 1 0 0 0 0 0 0 18 8.5 2.87 0 0 0 0 0 1 0 0 0 0 0 19 8.5 3.14 0 0 0 0 0 0 1 0 0 0 0 20 8.5 3.11 0 0 0 0 0 0 0 1 0 0 0 21 8.5 3.16 0 0 0 0 0 0 0 0 1 0 0 22 8.5 2.47 0 0 0 0 0 0 0 0 0 1 0 23 8.5 2.57 0 0 0 0 0 0 0 0 0 0 1 24 8.5 2.89 0 0 0 0 0 0 0 0 0 0 0 25 8.5 2.63 1 0 0 0 0 0 0 0 0 0 0 26 8.5 2.38 0 1 0 0 0 0 0 0 0 0 0 27 8.5 1.69 0 0 1 0 0 0 0 0 0 0 0 28 8.5 1.96 0 0 0 1 0 0 0 0 0 0 0 29 8.6 2.19 0 0 0 0 1 0 0 0 0 0 0 30 8.4 1.87 0 0 0 0 0 1 0 0 0 0 0 31 8.1 1.60 0 0 0 0 0 0 1 0 0 0 0 32 8.0 1.63 0 0 0 0 0 0 0 1 0 0 0 33 8.0 1.22 0 0 0 0 0 0 0 0 1 0 0 34 8.0 1.21 0 0 0 0 0 0 0 0 0 1 0 35 8.0 1.49 0 0 0 0 0 0 0 0 0 0 1 36 7.9 1.64 0 0 0 0 0 0 0 0 0 0 0 37 7.8 1.66 1 0 0 0 0 0 0 0 0 0 0 38 7.8 1.77 0 1 0 0 0 0 0 0 0 0 0 39 7.9 1.82 0 0 1 0 0 0 0 0 0 0 0 40 8.1 1.78 0 0 0 1 0 0 0 0 0 0 0 41 8.0 1.28 0 0 0 0 1 0 0 0 0 0 0 42 7.6 1.29 0 0 0 0 0 1 0 0 0 0 0 43 7.3 1.37 0 0 0 0 0 0 1 0 0 0 0 44 7.0 1.12 0 0 0 0 0 0 0 1 0 0 0 45 6.8 1.51 0 0 0 0 0 0 0 0 1 0 0 46 7.0 2.24 0 0 0 0 0 0 0 0 0 1 0 47 7.1 2.94 0 0 0 0 0 0 0 0 0 0 1 48 7.2 3.09 0 0 0 0 0 0 0 0 0 0 0 49 7.1 3.46 1 0 0 0 0 0 0 0 0 0 0 50 6.9 3.64 0 1 0 0 0 0 0 0 0 0 0 51 6.7 4.39 0 0 1 0 0 0 0 0 0 0 0 52 6.7 4.15 0 0 0 1 0 0 0 0 0 0 0 53 6.6 5.21 0 0 0 0 1 0 0 0 0 0 0 54 6.9 5.80 0 0 0 0 0 1 0 0 0 0 0 55 7.3 5.91 0 0 0 0 0 0 1 0 0 0 0 56 7.5 5.39 0 0 0 0 0 0 0 1 0 0 0 57 7.3 5.46 0 0 0 0 0 0 0 0 1 0 0 58 7.1 4.72 0 0 0 0 0 0 0 0 0 1 0 59 6.9 3.14 0 0 0 0 0 0 0 0 0 0 1 60 7.1 2.63 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) X M1 M2 M3 M4 8.39940 -0.23938 0.21595 0.17691 0.15989 0.10239 M5 M6 M7 M8 M9 M10 0.18128 0.15516 0.25144 0.22740 0.14117 0.08692 M11 -0.03186 > (mysum <- summary(mylm)) Call: lm(formula = df) Residuals: Min 1Q Median 3Q Max -1.37911 -0.36896 0.01775 0.53026 0.84536 Coefficients: Estimate Std. Error t value Pr(>|t|) (Intercept) 8.39940 0.34424 24.400 < 2e-16 *** X -0.23938 0.07183 -3.332 0.00168 ** M1 0.21595 0.41530 0.520 0.60550 M2 0.17691 0.41529 0.426 0.67205 M3 0.15989 0.41513 0.385 0.70186 M4 0.10239 0.41509 0.247 0.80623 M5 0.18128 0.41549 0.436 0.66462 M6 0.15516 0.41570 0.373 0.71063 M7 0.25144 0.41599 0.604 0.54846 M8 0.22740 0.41533 0.548 0.58662 M9 0.14117 0.41527 0.340 0.73541 M10 0.08692 0.41532 0.209 0.83514 M11 -0.03186 0.41509 -0.077 0.93914 --- Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1 Residual standard error: 0.6563 on 47 degrees of freedom Multiple R-squared: 0.2049, Adjusted R-squared: 0.001947 F-statistic: 1.01 on 12 and 47 DF, p-value: 0.4555 > 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.074988035 0.149976070 0.92501196 [2,] 0.114766840 0.229533680 0.88523316 [3,] 0.074027554 0.148055107 0.92597245 [4,] 0.038215123 0.076430247 0.96178488 [5,] 0.028778138 0.057556277 0.97122186 [6,] 0.023010208 0.046020416 0.97698979 [7,] 0.013449748 0.026899495 0.98655025 [8,] 0.009307334 0.018614668 0.99069267 [9,] 0.007175036 0.014350072 0.99282496 [10,] 0.004723340 0.009446680 0.99527666 [11,] 0.003369141 0.006738283 0.99663086 [12,] 0.002226647 0.004453295 0.99777335 [13,] 0.002691155 0.005382311 0.99730884 [14,] 0.004413792 0.008827585 0.99558621 [15,] 0.003656189 0.007312377 0.99634381 [16,] 0.003788982 0.007577964 0.99621102 [17,] 0.006552126 0.013104252 0.99344787 [18,] 0.008469603 0.016939207 0.99153040 [19,] 0.007493823 0.014987646 0.99250618 [20,] 0.007897114 0.015794229 0.99210289 [21,] 0.007266780 0.014533560 0.99273322 [22,] 0.008524044 0.017048088 0.99147596 [23,] 0.012725995 0.025451990 0.98727401 [24,] 0.024483464 0.048966929 0.97551654 [25,] 0.080545502 0.161091004 0.91945450 [26,] 0.494402023 0.988804046 0.50559798 [27,] 0.931163640 0.137672721 0.06883636 [28,] 0.981553754 0.036892491 0.01844625 [29,] 0.955543003 0.088913994 0.04445700 > postscript(file="/var/www/html/rcomp/tmp/1vpai1258554847.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/2snm91258554847.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/31ngb1258554847.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/4sjzd1258554847.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/5ff1n1258554847.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.36525414 0.22530193 0.01120252 -0.24219047 -0.15590668 -0.01357286 7 8 9 10 11 12 0.52605613 0.81419497 0.84536188 0.79830046 0.54287253 0.44398557 13 14 15 16 17 18 0.22563733 0.43888696 0.67559563 0.55888696 0.62015553 0.63244765 19 20 21 22 23 24 0.60080198 0.61766618 0.71585890 0.60494309 0.74766009 0.79239986 25 26 27 28 29 30 0.51420715 0.49340516 0.34525414 0.46738465 0.54355460 0.29306976 31 32 33 34 35 36 -0.16783996 -0.23661310 -0.24853420 -0.19667305 -0.01086803 -0.10682250 37 38 39 40 41 42 -0.41798941 -0.35261535 -0.22362673 0.02429663 -0.27427927 -0.64576941 43 44 45 46 47 48 -1.02289688 -1.35869582 -1.37911462 -0.95011383 -0.56377009 -0.45972456 49 50 51 52 53 54 -0.68710921 -0.80497870 -0.80842556 -0.80837778 -0.73352417 -0.26617514 55 56 57 58 59 60 0.06387873 0.16344776 0.06642804 -0.25645667 -0.71589451 -0.66983839 > postscript(file="/var/www/html/rcomp/tmp/67txd1258554847.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.36525414 NA 1 0.22530193 0.36525414 2 0.01120252 0.22530193 3 -0.24219047 0.01120252 4 -0.15590668 -0.24219047 5 -0.01357286 -0.15590668 6 0.52605613 -0.01357286 7 0.81419497 0.52605613 8 0.84536188 0.81419497 9 0.79830046 0.84536188 10 0.54287253 0.79830046 11 0.44398557 0.54287253 12 0.22563733 0.44398557 13 0.43888696 0.22563733 14 0.67559563 0.43888696 15 0.55888696 0.67559563 16 0.62015553 0.55888696 17 0.63244765 0.62015553 18 0.60080198 0.63244765 19 0.61766618 0.60080198 20 0.71585890 0.61766618 21 0.60494309 0.71585890 22 0.74766009 0.60494309 23 0.79239986 0.74766009 24 0.51420715 0.79239986 25 0.49340516 0.51420715 26 0.34525414 0.49340516 27 0.46738465 0.34525414 28 0.54355460 0.46738465 29 0.29306976 0.54355460 30 -0.16783996 0.29306976 31 -0.23661310 -0.16783996 32 -0.24853420 -0.23661310 33 -0.19667305 -0.24853420 34 -0.01086803 -0.19667305 35 -0.10682250 -0.01086803 36 -0.41798941 -0.10682250 37 -0.35261535 -0.41798941 38 -0.22362673 -0.35261535 39 0.02429663 -0.22362673 40 -0.27427927 0.02429663 41 -0.64576941 -0.27427927 42 -1.02289688 -0.64576941 43 -1.35869582 -1.02289688 44 -1.37911462 -1.35869582 45 -0.95011383 -1.37911462 46 -0.56377009 -0.95011383 47 -0.45972456 -0.56377009 48 -0.68710921 -0.45972456 49 -0.80497870 -0.68710921 50 -0.80842556 -0.80497870 51 -0.80837778 -0.80842556 52 -0.73352417 -0.80837778 53 -0.26617514 -0.73352417 54 0.06387873 -0.26617514 55 0.16344776 0.06387873 56 0.06642804 0.16344776 57 -0.25645667 0.06642804 58 -0.71589451 -0.25645667 59 -0.66983839 -0.71589451 60 NA -0.66983839 > dum1 <- dum[2:length(myerror),] > dum1 lag(myerror, k = 1) myerror [1,] 0.22530193 0.36525414 [2,] 0.01120252 0.22530193 [3,] -0.24219047 0.01120252 [4,] -0.15590668 -0.24219047 [5,] -0.01357286 -0.15590668 [6,] 0.52605613 -0.01357286 [7,] 0.81419497 0.52605613 [8,] 0.84536188 0.81419497 [9,] 0.79830046 0.84536188 [10,] 0.54287253 0.79830046 [11,] 0.44398557 0.54287253 [12,] 0.22563733 0.44398557 [13,] 0.43888696 0.22563733 [14,] 0.67559563 0.43888696 [15,] 0.55888696 0.67559563 [16,] 0.62015553 0.55888696 [17,] 0.63244765 0.62015553 [18,] 0.60080198 0.63244765 [19,] 0.61766618 0.60080198 [20,] 0.71585890 0.61766618 [21,] 0.60494309 0.71585890 [22,] 0.74766009 0.60494309 [23,] 0.79239986 0.74766009 [24,] 0.51420715 0.79239986 [25,] 0.49340516 0.51420715 [26,] 0.34525414 0.49340516 [27,] 0.46738465 0.34525414 [28,] 0.54355460 0.46738465 [29,] 0.29306976 0.54355460 [30,] -0.16783996 0.29306976 [31,] -0.23661310 -0.16783996 [32,] -0.24853420 -0.23661310 [33,] -0.19667305 -0.24853420 [34,] -0.01086803 -0.19667305 [35,] -0.10682250 -0.01086803 [36,] -0.41798941 -0.10682250 [37,] -0.35261535 -0.41798941 [38,] -0.22362673 -0.35261535 [39,] 0.02429663 -0.22362673 [40,] -0.27427927 0.02429663 [41,] -0.64576941 -0.27427927 [42,] -1.02289688 -0.64576941 [43,] -1.35869582 -1.02289688 [44,] -1.37911462 -1.35869582 [45,] -0.95011383 -1.37911462 [46,] -0.56377009 -0.95011383 [47,] -0.45972456 -0.56377009 [48,] -0.68710921 -0.45972456 [49,] -0.80497870 -0.68710921 [50,] -0.80842556 -0.80497870 [51,] -0.80837778 -0.80842556 [52,] -0.73352417 -0.80837778 [53,] -0.26617514 -0.73352417 [54,] 0.06387873 -0.26617514 [55,] 0.16344776 0.06387873 [56,] 0.06642804 0.16344776 [57,] -0.25645667 0.06642804 [58,] -0.71589451 -0.25645667 [59,] -0.66983839 -0.71589451 > z <- as.data.frame(dum1) > z lag(myerror, k = 1) myerror 1 0.22530193 0.36525414 2 0.01120252 0.22530193 3 -0.24219047 0.01120252 4 -0.15590668 -0.24219047 5 -0.01357286 -0.15590668 6 0.52605613 -0.01357286 7 0.81419497 0.52605613 8 0.84536188 0.81419497 9 0.79830046 0.84536188 10 0.54287253 0.79830046 11 0.44398557 0.54287253 12 0.22563733 0.44398557 13 0.43888696 0.22563733 14 0.67559563 0.43888696 15 0.55888696 0.67559563 16 0.62015553 0.55888696 17 0.63244765 0.62015553 18 0.60080198 0.63244765 19 0.61766618 0.60080198 20 0.71585890 0.61766618 21 0.60494309 0.71585890 22 0.74766009 0.60494309 23 0.79239986 0.74766009 24 0.51420715 0.79239986 25 0.49340516 0.51420715 26 0.34525414 0.49340516 27 0.46738465 0.34525414 28 0.54355460 0.46738465 29 0.29306976 0.54355460 30 -0.16783996 0.29306976 31 -0.23661310 -0.16783996 32 -0.24853420 -0.23661310 33 -0.19667305 -0.24853420 34 -0.01086803 -0.19667305 35 -0.10682250 -0.01086803 36 -0.41798941 -0.10682250 37 -0.35261535 -0.41798941 38 -0.22362673 -0.35261535 39 0.02429663 -0.22362673 40 -0.27427927 0.02429663 41 -0.64576941 -0.27427927 42 -1.02289688 -0.64576941 43 -1.35869582 -1.02289688 44 -1.37911462 -1.35869582 45 -0.95011383 -1.37911462 46 -0.56377009 -0.95011383 47 -0.45972456 -0.56377009 48 -0.68710921 -0.45972456 49 -0.80497870 -0.68710921 50 -0.80842556 -0.80497870 51 -0.80837778 -0.80842556 52 -0.73352417 -0.80837778 53 -0.26617514 -0.73352417 54 0.06387873 -0.26617514 55 0.16344776 0.06387873 56 0.06642804 0.16344776 57 -0.25645667 0.06642804 58 -0.71589451 -0.25645667 59 -0.66983839 -0.71589451 > 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/72g331258554847.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/890cg1258554847.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/92c1z1258554847.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/1040io1258554848.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/11dyem1258554848.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/128egn1258554848.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/133tzd1258554848.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/14oues1258554848.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/15ujcd1258554848.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/16lr3b1258554848.tab") + } > > system("convert tmp/1vpai1258554847.ps tmp/1vpai1258554847.png") > system("convert tmp/2snm91258554847.ps tmp/2snm91258554847.png") > system("convert tmp/31ngb1258554847.ps tmp/31ngb1258554847.png") > system("convert tmp/4sjzd1258554847.ps tmp/4sjzd1258554847.png") > system("convert tmp/5ff1n1258554847.ps tmp/5ff1n1258554847.png") > system("convert tmp/67txd1258554847.ps tmp/67txd1258554847.png") > system("convert tmp/72g331258554847.ps tmp/72g331258554847.png") > system("convert tmp/890cg1258554847.ps tmp/890cg1258554847.png") > system("convert tmp/92c1z1258554847.ps tmp/92c1z1258554847.png") > system("convert tmp/1040io1258554848.ps tmp/1040io1258554848.png") > > > proc.time() user system elapsed 2.363 1.585 2.868