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(99.90,0,99.80,0,99.80,0,100.30,0,99.90,0,99.90,0,100.00,0,100.10,0,100.10,0,100.20,0,100.30,0,100.60,0,100.00,0,100.10,0,100.20,0,100.00,0,100.10,0,100.10,0,100.10,0,100.50,0,100.50,0,100.50,0,96.30,1,96.30,1,96.80,1,96.80,1,96.90,1,96.80,1,96.80,1,96.80,1,96.80,1,97.00,1,97.00,1,97.00,1,96.80,1,96.90,1,97.20,1,97.30,1,97.30,1,97.20,1,97.30,1,97.30,1,97.30,1,97.30,1,97.30,1,97.30,1,98.10,1,96.80,1,96.80,1,96.80,1,96.80,1,96.80,1,96.80,1,96.80,1,96.80,1,96.80,1,96.80,1,96.80,1,96.90,1,97.10,1,97.10,1),dim=c(2,61),dimnames=list(c('x','d'),1:61)) > y <- array(NA,dim=c(2,61),dimnames=list(c('x','d'),1:61)) > 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 x d M1 M2 M3 M4 M5 M6 M7 M8 M9 M10 M11 t 1 99.9 0 1 0 0 0 0 0 0 0 0 0 0 1 2 99.8 0 0 1 0 0 0 0 0 0 0 0 0 2 3 99.8 0 0 0 1 0 0 0 0 0 0 0 0 3 4 100.3 0 0 0 0 1 0 0 0 0 0 0 0 4 5 99.9 0 0 0 0 0 1 0 0 0 0 0 0 5 6 99.9 0 0 0 0 0 0 1 0 0 0 0 0 6 7 100.0 0 0 0 0 0 0 0 1 0 0 0 0 7 8 100.1 0 0 0 0 0 0 0 0 1 0 0 0 8 9 100.1 0 0 0 0 0 0 0 0 0 1 0 0 9 10 100.2 0 0 0 0 0 0 0 0 0 0 1 0 10 11 100.3 0 0 0 0 0 0 0 0 0 0 0 1 11 12 100.6 0 0 0 0 0 0 0 0 0 0 0 0 12 13 100.0 0 1 0 0 0 0 0 0 0 0 0 0 13 14 100.1 0 0 1 0 0 0 0 0 0 0 0 0 14 15 100.2 0 0 0 1 0 0 0 0 0 0 0 0 15 16 100.0 0 0 0 0 1 0 0 0 0 0 0 0 16 17 100.1 0 0 0 0 0 1 0 0 0 0 0 0 17 18 100.1 0 0 0 0 0 0 1 0 0 0 0 0 18 19 100.1 0 0 0 0 0 0 0 1 0 0 0 0 19 20 100.5 0 0 0 0 0 0 0 0 1 0 0 0 20 21 100.5 0 0 0 0 0 0 0 0 0 1 0 0 21 22 100.5 0 0 0 0 0 0 0 0 0 0 1 0 22 23 96.3 1 0 0 0 0 0 0 0 0 0 0 1 23 24 96.3 1 0 0 0 0 0 0 0 0 0 0 0 24 25 96.8 1 1 0 0 0 0 0 0 0 0 0 0 25 26 96.8 1 0 1 0 0 0 0 0 0 0 0 0 26 27 96.9 1 0 0 1 0 0 0 0 0 0 0 0 27 28 96.8 1 0 0 0 1 0 0 0 0 0 0 0 28 29 96.8 1 0 0 0 0 1 0 0 0 0 0 0 29 30 96.8 1 0 0 0 0 0 1 0 0 0 0 0 30 31 96.8 1 0 0 0 0 0 0 1 0 0 0 0 31 32 97.0 1 0 0 0 0 0 0 0 1 0 0 0 32 33 97.0 1 0 0 0 0 0 0 0 0 1 0 0 33 34 97.0 1 0 0 0 0 0 0 0 0 0 1 0 34 35 96.8 1 0 0 0 0 0 0 0 0 0 0 1 35 36 96.9 1 0 0 0 0 0 0 0 0 0 0 0 36 37 97.2 1 1 0 0 0 0 0 0 0 0 0 0 37 38 97.3 1 0 1 0 0 0 0 0 0 0 0 0 38 39 97.3 1 0 0 1 0 0 0 0 0 0 0 0 39 40 97.2 1 0 0 0 1 0 0 0 0 0 0 0 40 41 97.3 1 0 0 0 0 1 0 0 0 0 0 0 41 42 97.3 1 0 0 0 0 0 1 0 0 0 0 0 42 43 97.3 1 0 0 0 0 0 0 1 0 0 0 0 43 44 97.3 1 0 0 0 0 0 0 0 1 0 0 0 44 45 97.3 1 0 0 0 0 0 0 0 0 1 0 0 45 46 97.3 1 0 0 0 0 0 0 0 0 0 1 0 46 47 98.1 1 0 0 0 0 0 0 0 0 0 0 1 47 48 96.8 1 0 0 0 0 0 0 0 0 0 0 0 48 49 96.8 1 1 0 0 0 0 0 0 0 0 0 0 49 50 96.8 1 0 1 0 0 0 0 0 0 0 0 0 50 51 96.8 1 0 0 1 0 0 0 0 0 0 0 0 51 52 96.8 1 0 0 0 1 0 0 0 0 0 0 0 52 53 96.8 1 0 0 0 0 1 0 0 0 0 0 0 53 54 96.8 1 0 0 0 0 0 1 0 0 0 0 0 54 55 96.8 1 0 0 0 0 0 0 1 0 0 0 0 55 56 96.8 1 0 0 0 0 0 0 0 1 0 0 0 56 57 96.8 1 0 0 0 0 0 0 0 0 1 0 0 57 58 96.8 1 0 0 0 0 0 0 0 0 0 1 0 58 59 96.9 1 0 0 0 0 0 0 0 0 0 0 1 59 60 97.1 1 0 0 0 0 0 0 0 0 0 0 0 60 61 97.1 1 1 0 0 0 0 0 0 0 0 0 0 61 > k <- length(x[1,]) > df <- as.data.frame(x) > (mylm <- lm(df)) Call: lm(formula = df) Coefficients: (Intercept) d M1 M2 M3 M4 99.987186 -3.394582 0.011345 0.015661 0.048203 0.060746 M5 M6 M7 M8 M9 M10 0.013288 0.005830 0.018372 0.150915 0.143457 0.155999 M11 t 0.147458 0.007458 > (mysum <- summary(mylm)) Call: lm(formula = df) Residuals: Min 1Q Median 3Q Max -0.61159 -0.16938 -0.02217 0.19274 1.00942 Coefficients: Estimate Std. Error t value Pr(>|t|) (Intercept) 99.987186 0.155868 641.484 <2e-16 *** d -3.394582 0.147489 -23.016 <2e-16 *** M1 0.011345 0.181756 0.062 0.9505 M2 0.015661 0.190796 0.082 0.9349 M3 0.048203 0.190508 0.253 0.8014 M4 0.060746 0.190304 0.319 0.7510 M5 0.013288 0.190186 0.070 0.9446 M6 0.005830 0.190153 0.031 0.9757 M7 0.018372 0.190206 0.097 0.9235 M8 0.150915 0.190344 0.793 0.4318 M9 0.143457 0.190567 0.753 0.4553 M10 0.155999 0.190876 0.817 0.4179 M11 0.147458 0.189507 0.778 0.4404 t 0.007458 0.004034 1.849 0.0708 . --- Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1 Residual standard error: 0.2996 on 47 degrees of freedom Multiple R-squared: 0.9711, Adjusted R-squared: 0.9631 F-statistic: 121.5 on 13 and 47 DF, p-value: < 2.2e-16 > 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.261195548 0.522391095 0.7388045 [2,] 0.132563809 0.265127618 0.8674362 [3,] 0.062414564 0.124829128 0.9375854 [4,] 0.039780753 0.079561505 0.9602192 [5,] 0.023025205 0.046050411 0.9769748 [6,] 0.010010226 0.020020453 0.9899898 [7,] 0.007517080 0.015034159 0.9924829 [8,] 0.006744318 0.013488636 0.9932557 [9,] 0.079512934 0.159025868 0.9204871 [10,] 0.100989522 0.201979045 0.8990105 [11,] 0.097588288 0.195176576 0.9024117 [12,] 0.064942100 0.129884199 0.9350579 [13,] 0.049387862 0.098775725 0.9506121 [14,] 0.037146693 0.074293386 0.9628533 [15,] 0.027275256 0.054550512 0.9727247 [16,] 0.016313471 0.032626941 0.9836865 [17,] 0.009650888 0.019301776 0.9903491 [18,] 0.005737967 0.011475935 0.9942620 [19,] 0.038612739 0.077225479 0.9613873 [20,] 0.052144234 0.104288469 0.9478558 [21,] 0.052930903 0.105861805 0.9470691 [22,] 0.042101019 0.084202038 0.9578990 [23,] 0.027012340 0.054024681 0.9729877 [24,] 0.013656085 0.027312170 0.9863439 [25,] 0.007774463 0.015548926 0.9922255 [26,] 0.003976496 0.007952992 0.9960235 [27,] 0.001728575 0.003457150 0.9982714 [28,] 0.000624322 0.001248644 0.9993757 > postscript(file="/var/www/html/freestat/rcomp/tmp/1ko9n1227811757.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/freestat/rcomp/tmp/2ofa11227811757.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/freestat/rcomp/tmp/3pmr11227811757.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/freestat/rcomp/tmp/4mx7e1227811757.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/freestat/rcomp/tmp/5cbri1227811757.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 = 61 Frequency = 1 1 2 3 4 5 6 -0.105988593 -0.217762991 -0.257762991 0.222237009 -0.137762991 -0.137762991 7 8 9 10 11 12 -0.057762991 -0.097762991 -0.097762991 -0.017762991 0.083320659 0.523320659 13 14 15 16 17 18 -0.095481622 -0.007256020 0.052743980 -0.167256020 -0.027256020 -0.027256020 19 20 21 22 23 24 -0.047256020 0.212743980 0.212743980 0.192743980 -0.611590621 -0.471590621 25 26 27 28 29 30 0.009607098 -0.002167300 0.057832700 -0.062167300 -0.022167300 -0.022167300 31 32 33 34 35 36 -0.042167300 0.017832700 0.017832700 -0.002167300 -0.201083650 0.038916350 37 38 39 40 41 42 0.320114068 0.408339670 0.368339670 0.248339670 0.388339670 0.388339670 43 44 45 46 47 48 0.368339670 0.228339670 0.228339670 0.208339670 1.009423321 -0.150576679 49 50 51 52 53 54 -0.169378961 -0.181153359 -0.221153359 -0.241153359 -0.201153359 -0.201153359 55 56 57 58 59 60 -0.221153359 -0.361153359 -0.361153359 -0.381153359 -0.280069708 0.059930292 61 0.041128010 > postscript(file="/var/www/html/freestat/rcomp/tmp/6f7ok1227811757.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 = 61 Frequency = 1 lag(myerror, k = 1) myerror 0 -0.105988593 NA 1 -0.217762991 -0.105988593 2 -0.257762991 -0.217762991 3 0.222237009 -0.257762991 4 -0.137762991 0.222237009 5 -0.137762991 -0.137762991 6 -0.057762991 -0.137762991 7 -0.097762991 -0.057762991 8 -0.097762991 -0.097762991 9 -0.017762991 -0.097762991 10 0.083320659 -0.017762991 11 0.523320659 0.083320659 12 -0.095481622 0.523320659 13 -0.007256020 -0.095481622 14 0.052743980 -0.007256020 15 -0.167256020 0.052743980 16 -0.027256020 -0.167256020 17 -0.027256020 -0.027256020 18 -0.047256020 -0.027256020 19 0.212743980 -0.047256020 20 0.212743980 0.212743980 21 0.192743980 0.212743980 22 -0.611590621 0.192743980 23 -0.471590621 -0.611590621 24 0.009607098 -0.471590621 25 -0.002167300 0.009607098 26 0.057832700 -0.002167300 27 -0.062167300 0.057832700 28 -0.022167300 -0.062167300 29 -0.022167300 -0.022167300 30 -0.042167300 -0.022167300 31 0.017832700 -0.042167300 32 0.017832700 0.017832700 33 -0.002167300 0.017832700 34 -0.201083650 -0.002167300 35 0.038916350 -0.201083650 36 0.320114068 0.038916350 37 0.408339670 0.320114068 38 0.368339670 0.408339670 39 0.248339670 0.368339670 40 0.388339670 0.248339670 41 0.388339670 0.388339670 42 0.368339670 0.388339670 43 0.228339670 0.368339670 44 0.228339670 0.228339670 45 0.208339670 0.228339670 46 1.009423321 0.208339670 47 -0.150576679 1.009423321 48 -0.169378961 -0.150576679 49 -0.181153359 -0.169378961 50 -0.221153359 -0.181153359 51 -0.241153359 -0.221153359 52 -0.201153359 -0.241153359 53 -0.201153359 -0.201153359 54 -0.221153359 -0.201153359 55 -0.361153359 -0.221153359 56 -0.361153359 -0.361153359 57 -0.381153359 -0.361153359 58 -0.280069708 -0.381153359 59 0.059930292 -0.280069708 60 0.041128010 0.059930292 61 NA 0.041128010 > dum1 <- dum[2:length(myerror),] > dum1 lag(myerror, k = 1) myerror [1,] -0.217762991 -0.105988593 [2,] -0.257762991 -0.217762991 [3,] 0.222237009 -0.257762991 [4,] -0.137762991 0.222237009 [5,] -0.137762991 -0.137762991 [6,] -0.057762991 -0.137762991 [7,] -0.097762991 -0.057762991 [8,] -0.097762991 -0.097762991 [9,] -0.017762991 -0.097762991 [10,] 0.083320659 -0.017762991 [11,] 0.523320659 0.083320659 [12,] -0.095481622 0.523320659 [13,] -0.007256020 -0.095481622 [14,] 0.052743980 -0.007256020 [15,] -0.167256020 0.052743980 [16,] -0.027256020 -0.167256020 [17,] -0.027256020 -0.027256020 [18,] -0.047256020 -0.027256020 [19,] 0.212743980 -0.047256020 [20,] 0.212743980 0.212743980 [21,] 0.192743980 0.212743980 [22,] -0.611590621 0.192743980 [23,] -0.471590621 -0.611590621 [24,] 0.009607098 -0.471590621 [25,] -0.002167300 0.009607098 [26,] 0.057832700 -0.002167300 [27,] -0.062167300 0.057832700 [28,] -0.022167300 -0.062167300 [29,] -0.022167300 -0.022167300 [30,] -0.042167300 -0.022167300 [31,] 0.017832700 -0.042167300 [32,] 0.017832700 0.017832700 [33,] -0.002167300 0.017832700 [34,] -0.201083650 -0.002167300 [35,] 0.038916350 -0.201083650 [36,] 0.320114068 0.038916350 [37,] 0.408339670 0.320114068 [38,] 0.368339670 0.408339670 [39,] 0.248339670 0.368339670 [40,] 0.388339670 0.248339670 [41,] 0.388339670 0.388339670 [42,] 0.368339670 0.388339670 [43,] 0.228339670 0.368339670 [44,] 0.228339670 0.228339670 [45,] 0.208339670 0.228339670 [46,] 1.009423321 0.208339670 [47,] -0.150576679 1.009423321 [48,] -0.169378961 -0.150576679 [49,] -0.181153359 -0.169378961 [50,] -0.221153359 -0.181153359 [51,] -0.241153359 -0.221153359 [52,] -0.201153359 -0.241153359 [53,] -0.201153359 -0.201153359 [54,] -0.221153359 -0.201153359 [55,] -0.361153359 -0.221153359 [56,] -0.361153359 -0.361153359 [57,] -0.381153359 -0.361153359 [58,] -0.280069708 -0.381153359 [59,] 0.059930292 -0.280069708 [60,] 0.041128010 0.059930292 > z <- as.data.frame(dum1) > z lag(myerror, k = 1) myerror 1 -0.217762991 -0.105988593 2 -0.257762991 -0.217762991 3 0.222237009 -0.257762991 4 -0.137762991 0.222237009 5 -0.137762991 -0.137762991 6 -0.057762991 -0.137762991 7 -0.097762991 -0.057762991 8 -0.097762991 -0.097762991 9 -0.017762991 -0.097762991 10 0.083320659 -0.017762991 11 0.523320659 0.083320659 12 -0.095481622 0.523320659 13 -0.007256020 -0.095481622 14 0.052743980 -0.007256020 15 -0.167256020 0.052743980 16 -0.027256020 -0.167256020 17 -0.027256020 -0.027256020 18 -0.047256020 -0.027256020 19 0.212743980 -0.047256020 20 0.212743980 0.212743980 21 0.192743980 0.212743980 22 -0.611590621 0.192743980 23 -0.471590621 -0.611590621 24 0.009607098 -0.471590621 25 -0.002167300 0.009607098 26 0.057832700 -0.002167300 27 -0.062167300 0.057832700 28 -0.022167300 -0.062167300 29 -0.022167300 -0.022167300 30 -0.042167300 -0.022167300 31 0.017832700 -0.042167300 32 0.017832700 0.017832700 33 -0.002167300 0.017832700 34 -0.201083650 -0.002167300 35 0.038916350 -0.201083650 36 0.320114068 0.038916350 37 0.408339670 0.320114068 38 0.368339670 0.408339670 39 0.248339670 0.368339670 40 0.388339670 0.248339670 41 0.388339670 0.388339670 42 0.368339670 0.388339670 43 0.228339670 0.368339670 44 0.228339670 0.228339670 45 0.208339670 0.228339670 46 1.009423321 0.208339670 47 -0.150576679 1.009423321 48 -0.169378961 -0.150576679 49 -0.181153359 -0.169378961 50 -0.221153359 -0.181153359 51 -0.241153359 -0.221153359 52 -0.201153359 -0.241153359 53 -0.201153359 -0.201153359 54 -0.221153359 -0.201153359 55 -0.361153359 -0.221153359 56 -0.361153359 -0.361153359 57 -0.381153359 -0.361153359 58 -0.280069708 -0.381153359 59 0.059930292 -0.280069708 60 0.041128010 0.059930292 > 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/freestat/rcomp/tmp/7yslx1227811757.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/freestat/rcomp/tmp/8us401227811757.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/freestat/rcomp/tmp/9az7m1227811757.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/freestat/rcomp/tmp/10q5n61227811757.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/freestat/rcomp/createtable file can be downloaded at http://www.wessa.net/cretab > load(file="/var/www/html/freestat/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/freestat/rcomp/tmp/11mh131227811757.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/freestat/rcomp/tmp/12jxwn1227811757.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/freestat/rcomp/tmp/13zko11227811757.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/freestat/rcomp/tmp/148osz1227811757.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/freestat/rcomp/tmp/159rdg1227811757.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/freestat/rcomp/tmp/1603yn1227811758.tab") + } > > system("convert tmp/1ko9n1227811757.ps tmp/1ko9n1227811757.png") > system("convert tmp/2ofa11227811757.ps tmp/2ofa11227811757.png") > system("convert tmp/3pmr11227811757.ps tmp/3pmr11227811757.png") > system("convert tmp/4mx7e1227811757.ps tmp/4mx7e1227811757.png") > system("convert tmp/5cbri1227811757.ps tmp/5cbri1227811757.png") > system("convert tmp/6f7ok1227811757.ps tmp/6f7ok1227811757.png") > system("convert tmp/7yslx1227811757.ps tmp/7yslx1227811757.png") > system("convert tmp/8us401227811757.ps tmp/8us401227811757.png") > system("convert tmp/9az7m1227811757.ps tmp/9az7m1227811757.png") > system("convert tmp/10q5n61227811757.ps tmp/10q5n61227811757.png") > > > proc.time() user system elapsed 3.544 2.431 3.932