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(23,25.7,19,24.7,18,24.2,19,23.6,19,24.4,22,22.5,23,19.4,20,18.1,14,18.1,14,20.7,14,19.1,15,18.3,11,16.9,17,17.9,16,20.2,20,21.2,24,23.8,23,24,20,26.6,21,25.3,19,27.6,23,24.7,23,26.6,23,24.4,23,24.6,27,26,26,24.8,17,24,24,22.7,26,23,24,24.1,27,24,27,22.7,26,22.6,24,23.1,23,24.4,23,23,24,22,17,21.3,21,21.5,19,21.3,22,23.2,22,21.8,18,23.3,16,21,14,22.4,12,20.4,14,19.9,16,21.3,8,18.9,3,15.6,0,12.5,5,7.8,1,5.5,1,4,3,3.3,6,3.7,7,3.1,8,5,14,6.3),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 23 25.7 1 0 0 0 0 0 0 0 0 0 0 1 2 19 24.7 0 1 0 0 0 0 0 0 0 0 0 2 3 18 24.2 0 0 1 0 0 0 0 0 0 0 0 3 4 19 23.6 0 0 0 1 0 0 0 0 0 0 0 4 5 19 24.4 0 0 0 0 1 0 0 0 0 0 0 5 6 22 22.5 0 0 0 0 0 1 0 0 0 0 0 6 7 23 19.4 0 0 0 0 0 0 1 0 0 0 0 7 8 20 18.1 0 0 0 0 0 0 0 1 0 0 0 8 9 14 18.1 0 0 0 0 0 0 0 0 1 0 0 9 10 14 20.7 0 0 0 0 0 0 0 0 0 1 0 10 11 14 19.1 0 0 0 0 0 0 0 0 0 0 1 11 12 15 18.3 0 0 0 0 0 0 0 0 0 0 0 12 13 11 16.9 1 0 0 0 0 0 0 0 0 0 0 13 14 17 17.9 0 1 0 0 0 0 0 0 0 0 0 14 15 16 20.2 0 0 1 0 0 0 0 0 0 0 0 15 16 20 21.2 0 0 0 1 0 0 0 0 0 0 0 16 17 24 23.8 0 0 0 0 1 0 0 0 0 0 0 17 18 23 24.0 0 0 0 0 0 1 0 0 0 0 0 18 19 20 26.6 0 0 0 0 0 0 1 0 0 0 0 19 20 21 25.3 0 0 0 0 0 0 0 1 0 0 0 20 21 19 27.6 0 0 0 0 0 0 0 0 1 0 0 21 22 23 24.7 0 0 0 0 0 0 0 0 0 1 0 22 23 23 26.6 0 0 0 0 0 0 0 0 0 0 1 23 24 23 24.4 0 0 0 0 0 0 0 0 0 0 0 24 25 23 24.6 1 0 0 0 0 0 0 0 0 0 0 25 26 27 26.0 0 1 0 0 0 0 0 0 0 0 0 26 27 26 24.8 0 0 1 0 0 0 0 0 0 0 0 27 28 17 24.0 0 0 0 1 0 0 0 0 0 0 0 28 29 24 22.7 0 0 0 0 1 0 0 0 0 0 0 29 30 26 23.0 0 0 0 0 0 1 0 0 0 0 0 30 31 24 24.1 0 0 0 0 0 0 1 0 0 0 0 31 32 27 24.0 0 0 0 0 0 0 0 1 0 0 0 32 33 27 22.7 0 0 0 0 0 0 0 0 1 0 0 33 34 26 22.6 0 0 0 0 0 0 0 0 0 1 0 34 35 24 23.1 0 0 0 0 0 0 0 0 0 0 1 35 36 23 24.4 0 0 0 0 0 0 0 0 0 0 0 36 37 23 23.0 1 0 0 0 0 0 0 0 0 0 0 37 38 24 22.0 0 1 0 0 0 0 0 0 0 0 0 38 39 17 21.3 0 0 1 0 0 0 0 0 0 0 0 39 40 21 21.5 0 0 0 1 0 0 0 0 0 0 0 40 41 19 21.3 0 0 0 0 1 0 0 0 0 0 0 41 42 22 23.2 0 0 0 0 0 1 0 0 0 0 0 42 43 22 21.8 0 0 0 0 0 0 1 0 0 0 0 43 44 18 23.3 0 0 0 0 0 0 0 1 0 0 0 44 45 16 21.0 0 0 0 0 0 0 0 0 1 0 0 45 46 14 22.4 0 0 0 0 0 0 0 0 0 1 0 46 47 12 20.4 0 0 0 0 0 0 0 0 0 0 1 47 48 14 19.9 0 0 0 0 0 0 0 0 0 0 0 48 49 16 21.3 1 0 0 0 0 0 0 0 0 0 0 49 50 8 18.9 0 1 0 0 0 0 0 0 0 0 0 50 51 3 15.6 0 0 1 0 0 0 0 0 0 0 0 51 52 0 12.5 0 0 0 1 0 0 0 0 0 0 0 52 53 5 7.8 0 0 0 0 1 0 0 0 0 0 0 53 54 1 5.5 0 0 0 0 0 1 0 0 0 0 0 54 55 1 4.0 0 0 0 0 0 0 1 0 0 0 0 55 56 3 3.3 0 0 0 0 0 0 0 1 0 0 0 56 57 6 3.7 0 0 0 0 0 0 0 0 1 0 0 57 58 7 3.1 0 0 0 0 0 0 0 0 0 1 0 58 59 8 5.0 0 0 0 0 0 0 0 0 0 0 1 59 60 14 6.3 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 1.82388 0.89228 -2.05379 -1.87816 -4.25270 -4.24507 M5 M6 M7 M8 M9 M10 -0.92668 0.01326 -0.35757 -0.19979 -1.42046 -1.07313 M11 t -1.77933 -0.01872 > (mysum <- summary(mylm)) Call: lm(formula = df) Residuals: Min 1Q Median 3Q Max -7.8739 -2.9329 0.1420 3.3931 7.6778 Coefficients: Estimate Std. Error t value Pr(>|t|) (Intercept) 1.82388 3.78847 0.481 0.632 X 0.89228 0.11161 7.995 3.01e-10 *** M1 -2.05379 2.84842 -0.721 0.475 M2 -1.87816 2.84332 -0.661 0.512 M3 -4.25270 2.83792 -1.499 0.141 M4 -4.24507 2.83383 -1.498 0.141 M5 -0.92668 2.83087 -0.327 0.745 M6 0.01326 2.82840 0.005 0.996 M7 -0.35757 2.82666 -0.127 0.900 M8 -0.19979 2.82529 -0.071 0.944 M9 -1.42046 2.82372 -0.503 0.617 M10 -1.07313 2.82196 -0.380 0.705 M11 -1.77933 2.82098 -0.631 0.531 t -0.01872 0.04211 -0.445 0.659 --- Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1 Residual standard error: 4.46 on 46 degrees of freedom Multiple R-squared: 0.7045, Adjusted R-squared: 0.621 F-statistic: 8.438 on 13 and 46 DF, p-value: 2.343e-08 > 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.07984212 0.15968424 0.9201579 [2,] 0.09995893 0.19991786 0.9000411 [3,] 0.26124925 0.52249851 0.7387507 [4,] 0.17260407 0.34520815 0.8273959 [5,] 0.15044459 0.30088918 0.8495554 [6,] 0.21525824 0.43051647 0.7847418 [7,] 0.20461702 0.40923404 0.7953830 [8,] 0.21450995 0.42901990 0.7854900 [9,] 0.20552551 0.41105102 0.7944745 [10,] 0.17705131 0.35410262 0.8229487 [11,] 0.16685341 0.33370682 0.8331466 [12,] 0.22414311 0.44828622 0.7758569 [13,] 0.16366591 0.32733182 0.8363341 [14,] 0.11060333 0.22120666 0.8893967 [15,] 0.07446947 0.14893894 0.9255305 [16,] 0.04958318 0.09916636 0.9504168 [17,] 0.06629618 0.13259236 0.9337038 [18,] 0.04854316 0.09708632 0.9514568 [19,] 0.02898640 0.05797281 0.9710136 [20,] 0.03162169 0.06324338 0.9683783 [21,] 0.02538433 0.05076867 0.9746157 [22,] 0.01343529 0.02687058 0.9865647 [23,] 0.01126525 0.02253051 0.9887347 [24,] 0.03118875 0.06237749 0.9688113 [25,] 0.05927248 0.11854495 0.9407275 [26,] 0.14199043 0.28398086 0.8580096 [27,] 0.69053598 0.61892803 0.3094640 > postscript(file="/var/www/html/rcomp/tmp/1l0kv1258625844.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/2kanq1258625844.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/3k11i1258625844.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/4r5ry1258625845.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/5wed51258625845.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.31702348 -2.94760825 -1.10821873 0.43824445 -3.57525697 0.19885493 7 8 9 10 11 12 4.35447532 2.37537333 -2.38523715 -5.03378388 -2.88121590 -2.92800202 13 14 15 16 17 18 -3.60629706 1.34451031 0.68551457 3.80432902 2.18472280 0.08504574 19 20 21 22 23 24 -4.84533244 -2.82443442 -5.63728994 0.62170580 -0.34870779 -0.14630128 25 26 27 28 29 30 1.74775496 4.34165015 6.80563599 -1.46944475 3.39084278 4.20193769 31 32 33 34 35 36 1.60998018 4.56014166 6.95949576 5.72010624 3.99888528 0.07831021 37 38 39 40 41 42 3.40001518 5.13538345 1.15322906 4.98586787 -0.13535309 0.24809309 43 44 45 46 47 48 1.88683671 -3.59065054 -2.29901598 -5.87682618 -5.36734601 -4.68181627 49 50 51 52 53 54 -1.85849657 -7.87393566 -7.53616088 -7.75899658 -1.86495552 -4.73393144 55 56 57 58 59 60 -3.00595977 -0.52043003 3.36204731 4.56879802 4.59838442 7.67780935 > postscript(file="/var/www/html/rcomp/tmp/6uwvr1258625845.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.31702348 NA 1 -2.94760825 0.31702348 2 -1.10821873 -2.94760825 3 0.43824445 -1.10821873 4 -3.57525697 0.43824445 5 0.19885493 -3.57525697 6 4.35447532 0.19885493 7 2.37537333 4.35447532 8 -2.38523715 2.37537333 9 -5.03378388 -2.38523715 10 -2.88121590 -5.03378388 11 -2.92800202 -2.88121590 12 -3.60629706 -2.92800202 13 1.34451031 -3.60629706 14 0.68551457 1.34451031 15 3.80432902 0.68551457 16 2.18472280 3.80432902 17 0.08504574 2.18472280 18 -4.84533244 0.08504574 19 -2.82443442 -4.84533244 20 -5.63728994 -2.82443442 21 0.62170580 -5.63728994 22 -0.34870779 0.62170580 23 -0.14630128 -0.34870779 24 1.74775496 -0.14630128 25 4.34165015 1.74775496 26 6.80563599 4.34165015 27 -1.46944475 6.80563599 28 3.39084278 -1.46944475 29 4.20193769 3.39084278 30 1.60998018 4.20193769 31 4.56014166 1.60998018 32 6.95949576 4.56014166 33 5.72010624 6.95949576 34 3.99888528 5.72010624 35 0.07831021 3.99888528 36 3.40001518 0.07831021 37 5.13538345 3.40001518 38 1.15322906 5.13538345 39 4.98586787 1.15322906 40 -0.13535309 4.98586787 41 0.24809309 -0.13535309 42 1.88683671 0.24809309 43 -3.59065054 1.88683671 44 -2.29901598 -3.59065054 45 -5.87682618 -2.29901598 46 -5.36734601 -5.87682618 47 -4.68181627 -5.36734601 48 -1.85849657 -4.68181627 49 -7.87393566 -1.85849657 50 -7.53616088 -7.87393566 51 -7.75899658 -7.53616088 52 -1.86495552 -7.75899658 53 -4.73393144 -1.86495552 54 -3.00595977 -4.73393144 55 -0.52043003 -3.00595977 56 3.36204731 -0.52043003 57 4.56879802 3.36204731 58 4.59838442 4.56879802 59 7.67780935 4.59838442 60 NA 7.67780935 > dum1 <- dum[2:length(myerror),] > dum1 lag(myerror, k = 1) myerror [1,] -2.94760825 0.31702348 [2,] -1.10821873 -2.94760825 [3,] 0.43824445 -1.10821873 [4,] -3.57525697 0.43824445 [5,] 0.19885493 -3.57525697 [6,] 4.35447532 0.19885493 [7,] 2.37537333 4.35447532 [8,] -2.38523715 2.37537333 [9,] -5.03378388 -2.38523715 [10,] -2.88121590 -5.03378388 [11,] -2.92800202 -2.88121590 [12,] -3.60629706 -2.92800202 [13,] 1.34451031 -3.60629706 [14,] 0.68551457 1.34451031 [15,] 3.80432902 0.68551457 [16,] 2.18472280 3.80432902 [17,] 0.08504574 2.18472280 [18,] -4.84533244 0.08504574 [19,] -2.82443442 -4.84533244 [20,] -5.63728994 -2.82443442 [21,] 0.62170580 -5.63728994 [22,] -0.34870779 0.62170580 [23,] -0.14630128 -0.34870779 [24,] 1.74775496 -0.14630128 [25,] 4.34165015 1.74775496 [26,] 6.80563599 4.34165015 [27,] -1.46944475 6.80563599 [28,] 3.39084278 -1.46944475 [29,] 4.20193769 3.39084278 [30,] 1.60998018 4.20193769 [31,] 4.56014166 1.60998018 [32,] 6.95949576 4.56014166 [33,] 5.72010624 6.95949576 [34,] 3.99888528 5.72010624 [35,] 0.07831021 3.99888528 [36,] 3.40001518 0.07831021 [37,] 5.13538345 3.40001518 [38,] 1.15322906 5.13538345 [39,] 4.98586787 1.15322906 [40,] -0.13535309 4.98586787 [41,] 0.24809309 -0.13535309 [42,] 1.88683671 0.24809309 [43,] -3.59065054 1.88683671 [44,] -2.29901598 -3.59065054 [45,] -5.87682618 -2.29901598 [46,] -5.36734601 -5.87682618 [47,] -4.68181627 -5.36734601 [48,] -1.85849657 -4.68181627 [49,] -7.87393566 -1.85849657 [50,] -7.53616088 -7.87393566 [51,] -7.75899658 -7.53616088 [52,] -1.86495552 -7.75899658 [53,] -4.73393144 -1.86495552 [54,] -3.00595977 -4.73393144 [55,] -0.52043003 -3.00595977 [56,] 3.36204731 -0.52043003 [57,] 4.56879802 3.36204731 [58,] 4.59838442 4.56879802 [59,] 7.67780935 4.59838442 > z <- as.data.frame(dum1) > z lag(myerror, k = 1) myerror 1 -2.94760825 0.31702348 2 -1.10821873 -2.94760825 3 0.43824445 -1.10821873 4 -3.57525697 0.43824445 5 0.19885493 -3.57525697 6 4.35447532 0.19885493 7 2.37537333 4.35447532 8 -2.38523715 2.37537333 9 -5.03378388 -2.38523715 10 -2.88121590 -5.03378388 11 -2.92800202 -2.88121590 12 -3.60629706 -2.92800202 13 1.34451031 -3.60629706 14 0.68551457 1.34451031 15 3.80432902 0.68551457 16 2.18472280 3.80432902 17 0.08504574 2.18472280 18 -4.84533244 0.08504574 19 -2.82443442 -4.84533244 20 -5.63728994 -2.82443442 21 0.62170580 -5.63728994 22 -0.34870779 0.62170580 23 -0.14630128 -0.34870779 24 1.74775496 -0.14630128 25 4.34165015 1.74775496 26 6.80563599 4.34165015 27 -1.46944475 6.80563599 28 3.39084278 -1.46944475 29 4.20193769 3.39084278 30 1.60998018 4.20193769 31 4.56014166 1.60998018 32 6.95949576 4.56014166 33 5.72010624 6.95949576 34 3.99888528 5.72010624 35 0.07831021 3.99888528 36 3.40001518 0.07831021 37 5.13538345 3.40001518 38 1.15322906 5.13538345 39 4.98586787 1.15322906 40 -0.13535309 4.98586787 41 0.24809309 -0.13535309 42 1.88683671 0.24809309 43 -3.59065054 1.88683671 44 -2.29901598 -3.59065054 45 -5.87682618 -2.29901598 46 -5.36734601 -5.87682618 47 -4.68181627 -5.36734601 48 -1.85849657 -4.68181627 49 -7.87393566 -1.85849657 50 -7.53616088 -7.87393566 51 -7.75899658 -7.53616088 52 -1.86495552 -7.75899658 53 -4.73393144 -1.86495552 54 -3.00595977 -4.73393144 55 -0.52043003 -3.00595977 56 3.36204731 -0.52043003 57 4.56879802 3.36204731 58 4.59838442 4.56879802 59 7.67780935 4.59838442 > 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/72iqk1258625845.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/8ofbt1258625845.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/9q9za1258625845.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/10oecp1258625845.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/11bzim1258625845.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/12kbtt1258625845.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/13lz351258625845.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/146opk1258625845.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/15rz8j1258625845.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/16do8u1258625845.tab") + } > > system("convert tmp/1l0kv1258625844.ps tmp/1l0kv1258625844.png") > system("convert tmp/2kanq1258625844.ps tmp/2kanq1258625844.png") > system("convert tmp/3k11i1258625844.ps tmp/3k11i1258625844.png") > system("convert tmp/4r5ry1258625845.ps tmp/4r5ry1258625845.png") > system("convert tmp/5wed51258625845.ps tmp/5wed51258625845.png") > system("convert tmp/6uwvr1258625845.ps tmp/6uwvr1258625845.png") > system("convert tmp/72iqk1258625845.ps tmp/72iqk1258625845.png") > system("convert tmp/8ofbt1258625845.ps tmp/8ofbt1258625845.png") > system("convert tmp/9q9za1258625845.ps tmp/9q9za1258625845.png") > system("convert tmp/10oecp1258625845.ps tmp/10oecp1258625845.png") > > > proc.time() user system elapsed 2.356 1.504 3.434