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(17823.2,1.2218,17872,1.249,17420.4,1.2991,16704.4,1.3408,15991.2,1.3119,16583.6,1.3014,19123.5,1.3201,17838.7,1.2938,17209.4,1.2694,18586.5,1.2165,16258.1,1.2037,15141.6,1.2292,19202.1,1.2256,17746.5,1.2015,19090.1,1.1786,18040.3,1.1856,17515.5,1.2103,17751.8,1.1938,21072.4,1.202,17170,1.2271,19439.5,1.277,19795.4,1.265,17574.9,1.2684,16165.4,1.2811,19464.6,1.2727,19932.1,1.2611,19961.2,1.2881,17343.4,1.3213,18924.2,1.2999,18574.1,1.3074,21350.6,1.3242,18594.6,1.3516,19823.1,1.3511,20844.4,1.3419,19640.2,1.3716,17735.4,1.3622,19813.6,1.3896,22160,1.4227,20664.3,1.4684,17877.4,1.457,20906.5,1.4718,21164.1,1.4748,22786.7,1.437,22321.5,1.3322,17842.2,1.2732,16373.5,1.3449,15993.8,1.3239,16446.1,1.2785,17729,1.305,16643,1.319,16196.7,1.365,18252.1,1.4016,17570.4,1.4088,15836.8,1.4268),dim=c(2,54),dimnames=list(c('UITV','EUDO'),1:54))
> y <- array(NA,dim=c(2,54),dimnames=list(c('UITV','EUDO'),1:54))
> 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 = '2'
> #'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
EUDO UITV M1 M2 M3 M4 M5 M6 M7 M8 M9 M10 M11
1 1.2218 17823.2 1 0 0 0 0 0 0 0 0 0 0
2 1.2490 17872.0 0 1 0 0 0 0 0 0 0 0 0
3 1.2991 17420.4 0 0 1 0 0 0 0 0 0 0 0
4 1.3408 16704.4 0 0 0 1 0 0 0 0 0 0 0
5 1.3119 15991.2 0 0 0 0 1 0 0 0 0 0 0
6 1.3014 16583.6 0 0 0 0 0 1 0 0 0 0 0
7 1.3201 19123.5 0 0 0 0 0 0 1 0 0 0 0
8 1.2938 17838.7 0 0 0 0 0 0 0 1 0 0 0
9 1.2694 17209.4 0 0 0 0 0 0 0 0 1 0 0
10 1.2165 18586.5 0 0 0 0 0 0 0 0 0 1 0
11 1.2037 16258.1 0 0 0 0 0 0 0 0 0 0 1
12 1.2292 15141.6 0 0 0 0 0 0 0 0 0 0 0
13 1.2256 19202.1 1 0 0 0 0 0 0 0 0 0 0
14 1.2015 17746.5 0 1 0 0 0 0 0 0 0 0 0
15 1.1786 19090.1 0 0 1 0 0 0 0 0 0 0 0
16 1.1856 18040.3 0 0 0 1 0 0 0 0 0 0 0
17 1.2103 17515.5 0 0 0 0 1 0 0 0 0 0 0
18 1.1938 17751.8 0 0 0 0 0 1 0 0 0 0 0
19 1.2020 21072.4 0 0 0 0 0 0 1 0 0 0 0
20 1.2271 17170.0 0 0 0 0 0 0 0 1 0 0 0
21 1.2770 19439.5 0 0 0 0 0 0 0 0 1 0 0
22 1.2650 19795.4 0 0 0 0 0 0 0 0 0 1 0
23 1.2684 17574.9 0 0 0 0 0 0 0 0 0 0 1
24 1.2811 16165.4 0 0 0 0 0 0 0 0 0 0 0
25 1.2727 19464.6 1 0 0 0 0 0 0 0 0 0 0
26 1.2611 19932.1 0 1 0 0 0 0 0 0 0 0 0
27 1.2881 19961.2 0 0 1 0 0 0 0 0 0 0 0
28 1.3213 17343.4 0 0 0 1 0 0 0 0 0 0 0
29 1.2999 18924.2 0 0 0 0 1 0 0 0 0 0 0
30 1.3074 18574.1 0 0 0 0 0 1 0 0 0 0 0
31 1.3242 21350.6 0 0 0 0 0 0 1 0 0 0 0
32 1.3516 18594.6 0 0 0 0 0 0 0 1 0 0 0
33 1.3511 19823.1 0 0 0 0 0 0 0 0 1 0 0
34 1.3419 20844.4 0 0 0 0 0 0 0 0 0 1 0
35 1.3716 19640.2 0 0 0 0 0 0 0 0 0 0 1
36 1.3622 17735.4 0 0 0 0 0 0 0 0 0 0 0
37 1.3896 19813.6 1 0 0 0 0 0 0 0 0 0 0
38 1.4227 22160.0 0 1 0 0 0 0 0 0 0 0 0
39 1.4684 20664.3 0 0 1 0 0 0 0 0 0 0 0
40 1.4570 17877.4 0 0 0 1 0 0 0 0 0 0 0
41 1.4718 20906.5 0 0 0 0 1 0 0 0 0 0 0
42 1.4748 21164.1 0 0 0 0 0 1 0 0 0 0 0
43 1.4370 22786.7 0 0 0 0 0 0 1 0 0 0 0
44 1.3322 22321.5 0 0 0 0 0 0 0 1 0 0 0
45 1.2732 17842.2 0 0 0 0 0 0 0 0 1 0 0
46 1.3449 16373.5 0 0 0 0 0 0 0 0 0 1 0
47 1.3239 15993.8 0 0 0 0 0 0 0 0 0 0 1
48 1.2785 16446.1 0 0 0 0 0 0 0 0 0 0 0
49 1.3050 17729.0 1 0 0 0 0 0 0 0 0 0 0
50 1.3190 16643.0 0 1 0 0 0 0 0 0 0 0 0
51 1.3650 16196.7 0 0 1 0 0 0 0 0 0 0 0
52 1.4016 18252.1 0 0 0 1 0 0 0 0 0 0 0
53 1.4088 17570.4 0 0 0 0 1 0 0 0 0 0 0
54 1.4268 15836.8 0 0 0 0 0 1 0 0 0 0 0
> k <- length(x[1,])
> df <- as.data.frame(x)
> (mylm <- lm(df))
Call:
lm(formula = df)
Coefficients:
(Intercept) UITV M1 M2 M3 M4
9.624e-01 1.987e-05 -5.318e-02 -4.674e-02 -1.350e-02 2.825e-02
M5 M6 M7 M8 M9 M10
1.683e-02 2.110e-02 -6.054e-02 -3.842e-02 -3.892e-02 -4.591e-02
M11
-1.561e-02
> (mysum <- summary(mylm))
Call:
lm(formula = df)
Residuals:
Min 1Q Median 3Q Max
-0.163545 -0.044052 -0.002239 0.055642 0.128589
Coefficients:
Estimate Std. Error t value Pr(>|t|)
(Intercept) 9.624e-01 1.253e-01 7.684 1.82e-09 ***
UITV 1.987e-05 7.259e-06 2.738 0.00911 **
M1 -5.318e-02 5.595e-02 -0.951 0.34738
M2 -4.674e-02 5.610e-02 -0.833 0.40956
M3 -1.350e-02 5.564e-02 -0.243 0.80945
M4 2.825e-02 5.388e-02 0.524 0.60294
M5 1.683e-02 5.469e-02 0.308 0.75976
M6 2.110e-02 5.436e-02 0.388 0.69991
M7 -6.054e-02 6.558e-02 -0.923 0.36130
M8 -3.842e-02 5.907e-02 -0.650 0.51908
M9 -3.892e-02 5.820e-02 -0.669 0.50745
M10 -4.591e-02 5.889e-02 -0.780 0.44013
M11 -1.561e-02 5.642e-02 -0.277 0.78336
---
Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
Residual standard error: 0.07913 on 41 degrees of freedom
Multiple R-squared: 0.2233, Adjusted R-squared: -0.004053
F-statistic: 0.9822 on 12 and 41 DF, p-value: 0.4813
> 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.26919570 0.53839139 0.73080430
[2,] 0.16090595 0.32181191 0.83909405
[3,] 0.13133451 0.26266901 0.86866549
[4,] 0.09580098 0.19160196 0.90419902
[5,] 0.16931414 0.33862828 0.83068586
[6,] 0.25063650 0.50127299 0.74936350
[7,] 0.28467426 0.56934852 0.71532574
[8,] 0.32650472 0.65300944 0.67349528
[9,] 0.28735628 0.57471256 0.71264372
[10,] 0.28346519 0.56693039 0.71653481
[11,] 0.32779909 0.65559818 0.67220091
[12,] 0.46009870 0.92019740 0.53990130
[13,] 0.48231940 0.96463880 0.51768060
[14,] 0.63977486 0.72045028 0.36022514
[15,] 0.88234823 0.23530353 0.11765177
[16,] 0.92318759 0.15362483 0.07681241
[17,] 0.94531439 0.10937121 0.05468561
[18,] 0.93499909 0.13000182 0.06500091
[19,] 0.95941451 0.08117098 0.04058549
[20,] 0.93458379 0.13083242 0.06541621
[21,] 0.93652203 0.12695595 0.06347797
[22,] 0.93361910 0.13276179 0.06638090
[23,] 0.85815972 0.28368056 0.14184028
> postscript(file="/var/www/html/rcomp/tmp/15xbq1258917820.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/2095s1258917820.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/39i5y1258917820.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/4hu2i1258917820.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/5u0b51258917820.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 = 54
Frequency = 1
1 2 3 4 5 6
-0.041600598 -0.021814184 0.004022361 0.018201490 0.014885194 -0.011650452
7 8 9 10 11 12
0.038218679 0.015327905 0.003931724 -0.069346356 -0.066169737 -0.034097928
13 14 15 16 17 18
-0.065201067 -0.066820342 -0.149656667 -0.163544515 -0.117004554 -0.142464048
19 20 21 22 23 24
-0.118608403 -0.038084189 -0.032783154 -0.044868712 -0.027636201 -0.002542116
25 26 27 28 29 30
-0.023317271 -0.050650949 -0.057466514 -0.013996240 -0.055397186 -0.045204178
31 32 33 34 35 36
-0.001936586 0.058107226 0.033694234 0.011186345 0.034523703 0.047360020
37 38 39 40 41 42
0.086647663 0.066677890 0.108862009 0.111092512 0.077112032 0.070729280
43 44 45 46 47 48
0.082326310 -0.035350941 -0.004842804 0.103028723 0.059282235 -0.010719976
49 50 51 52 53 54
0.043471274 0.072607584 0.094238812 0.048246754 0.080404514 0.128589398
> postscript(file="/var/www/html/rcomp/tmp/6cowb1258917820.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 = 54
Frequency = 1
lag(myerror, k = 1) myerror
0 -0.041600598 NA
1 -0.021814184 -0.041600598
2 0.004022361 -0.021814184
3 0.018201490 0.004022361
4 0.014885194 0.018201490
5 -0.011650452 0.014885194
6 0.038218679 -0.011650452
7 0.015327905 0.038218679
8 0.003931724 0.015327905
9 -0.069346356 0.003931724
10 -0.066169737 -0.069346356
11 -0.034097928 -0.066169737
12 -0.065201067 -0.034097928
13 -0.066820342 -0.065201067
14 -0.149656667 -0.066820342
15 -0.163544515 -0.149656667
16 -0.117004554 -0.163544515
17 -0.142464048 -0.117004554
18 -0.118608403 -0.142464048
19 -0.038084189 -0.118608403
20 -0.032783154 -0.038084189
21 -0.044868712 -0.032783154
22 -0.027636201 -0.044868712
23 -0.002542116 -0.027636201
24 -0.023317271 -0.002542116
25 -0.050650949 -0.023317271
26 -0.057466514 -0.050650949
27 -0.013996240 -0.057466514
28 -0.055397186 -0.013996240
29 -0.045204178 -0.055397186
30 -0.001936586 -0.045204178
31 0.058107226 -0.001936586
32 0.033694234 0.058107226
33 0.011186345 0.033694234
34 0.034523703 0.011186345
35 0.047360020 0.034523703
36 0.086647663 0.047360020
37 0.066677890 0.086647663
38 0.108862009 0.066677890
39 0.111092512 0.108862009
40 0.077112032 0.111092512
41 0.070729280 0.077112032
42 0.082326310 0.070729280
43 -0.035350941 0.082326310
44 -0.004842804 -0.035350941
45 0.103028723 -0.004842804
46 0.059282235 0.103028723
47 -0.010719976 0.059282235
48 0.043471274 -0.010719976
49 0.072607584 0.043471274
50 0.094238812 0.072607584
51 0.048246754 0.094238812
52 0.080404514 0.048246754
53 0.128589398 0.080404514
54 NA 0.128589398
> dum1 <- dum[2:length(myerror),]
> dum1
lag(myerror, k = 1) myerror
[1,] -0.021814184 -0.041600598
[2,] 0.004022361 -0.021814184
[3,] 0.018201490 0.004022361
[4,] 0.014885194 0.018201490
[5,] -0.011650452 0.014885194
[6,] 0.038218679 -0.011650452
[7,] 0.015327905 0.038218679
[8,] 0.003931724 0.015327905
[9,] -0.069346356 0.003931724
[10,] -0.066169737 -0.069346356
[11,] -0.034097928 -0.066169737
[12,] -0.065201067 -0.034097928
[13,] -0.066820342 -0.065201067
[14,] -0.149656667 -0.066820342
[15,] -0.163544515 -0.149656667
[16,] -0.117004554 -0.163544515
[17,] -0.142464048 -0.117004554
[18,] -0.118608403 -0.142464048
[19,] -0.038084189 -0.118608403
[20,] -0.032783154 -0.038084189
[21,] -0.044868712 -0.032783154
[22,] -0.027636201 -0.044868712
[23,] -0.002542116 -0.027636201
[24,] -0.023317271 -0.002542116
[25,] -0.050650949 -0.023317271
[26,] -0.057466514 -0.050650949
[27,] -0.013996240 -0.057466514
[28,] -0.055397186 -0.013996240
[29,] -0.045204178 -0.055397186
[30,] -0.001936586 -0.045204178
[31,] 0.058107226 -0.001936586
[32,] 0.033694234 0.058107226
[33,] 0.011186345 0.033694234
[34,] 0.034523703 0.011186345
[35,] 0.047360020 0.034523703
[36,] 0.086647663 0.047360020
[37,] 0.066677890 0.086647663
[38,] 0.108862009 0.066677890
[39,] 0.111092512 0.108862009
[40,] 0.077112032 0.111092512
[41,] 0.070729280 0.077112032
[42,] 0.082326310 0.070729280
[43,] -0.035350941 0.082326310
[44,] -0.004842804 -0.035350941
[45,] 0.103028723 -0.004842804
[46,] 0.059282235 0.103028723
[47,] -0.010719976 0.059282235
[48,] 0.043471274 -0.010719976
[49,] 0.072607584 0.043471274
[50,] 0.094238812 0.072607584
[51,] 0.048246754 0.094238812
[52,] 0.080404514 0.048246754
[53,] 0.128589398 0.080404514
> z <- as.data.frame(dum1)
> z
lag(myerror, k = 1) myerror
1 -0.021814184 -0.041600598
2 0.004022361 -0.021814184
3 0.018201490 0.004022361
4 0.014885194 0.018201490
5 -0.011650452 0.014885194
6 0.038218679 -0.011650452
7 0.015327905 0.038218679
8 0.003931724 0.015327905
9 -0.069346356 0.003931724
10 -0.066169737 -0.069346356
11 -0.034097928 -0.066169737
12 -0.065201067 -0.034097928
13 -0.066820342 -0.065201067
14 -0.149656667 -0.066820342
15 -0.163544515 -0.149656667
16 -0.117004554 -0.163544515
17 -0.142464048 -0.117004554
18 -0.118608403 -0.142464048
19 -0.038084189 -0.118608403
20 -0.032783154 -0.038084189
21 -0.044868712 -0.032783154
22 -0.027636201 -0.044868712
23 -0.002542116 -0.027636201
24 -0.023317271 -0.002542116
25 -0.050650949 -0.023317271
26 -0.057466514 -0.050650949
27 -0.013996240 -0.057466514
28 -0.055397186 -0.013996240
29 -0.045204178 -0.055397186
30 -0.001936586 -0.045204178
31 0.058107226 -0.001936586
32 0.033694234 0.058107226
33 0.011186345 0.033694234
34 0.034523703 0.011186345
35 0.047360020 0.034523703
36 0.086647663 0.047360020
37 0.066677890 0.086647663
38 0.108862009 0.066677890
39 0.111092512 0.108862009
40 0.077112032 0.111092512
41 0.070729280 0.077112032
42 0.082326310 0.070729280
43 -0.035350941 0.082326310
44 -0.004842804 -0.035350941
45 0.103028723 -0.004842804
46 0.059282235 0.103028723
47 -0.010719976 0.059282235
48 0.043471274 -0.010719976
49 0.072607584 0.043471274
50 0.094238812 0.072607584
51 0.048246754 0.094238812
52 0.080404514 0.048246754
53 0.128589398 0.080404514
> 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/7tord1258917820.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/8deum1258917820.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/9jt151258917820.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/10lgz31258917820.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/11p8js1258917820.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/127inf1258917821.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/13wjlz1258917821.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/14osjn1258917821.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/15m6jv1258917821.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/16ffbv1258917821.tab")
+ }
>
> system("convert tmp/15xbq1258917820.ps tmp/15xbq1258917820.png")
> system("convert tmp/2095s1258917820.ps tmp/2095s1258917820.png")
> system("convert tmp/39i5y1258917820.ps tmp/39i5y1258917820.png")
> system("convert tmp/4hu2i1258917820.ps tmp/4hu2i1258917820.png")
> system("convert tmp/5u0b51258917820.ps tmp/5u0b51258917820.png")
> system("convert tmp/6cowb1258917820.ps tmp/6cowb1258917820.png")
> system("convert tmp/7tord1258917820.ps tmp/7tord1258917820.png")
> system("convert tmp/8deum1258917820.ps tmp/8deum1258917820.png")
> system("convert tmp/9jt151258917820.ps tmp/9jt151258917820.png")
> system("convert tmp/10lgz31258917820.ps tmp/10lgz31258917820.png")
>
>
> proc.time()
user system elapsed
2.370 1.570 3.824