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(98.60,627,98.97,696,99.11,825,99.64,677,100.03,656,99.98,785,100.32,412,100.44,352,100.51,839,101.00,729,100.88,696,100.55,641,100.83,695,101.51,638,102.16,762,102.39,635,102.54,721,102.85,854,103.47,418,103.57,367,103.69,824,103.50,687,103.47,601,103.45,676,103.48,740,103.93,691,103.89,683,104.40,594,104.79,729,104.77,731,105.13,386,105.26,331,104.96,707,104.75,715,105.01,657,105.15,653,105.20,642,105.77,643,105.78,718,106.26,654,106.13,632,106.12,731,106.57,392,106.44,344,106.54,792,107.10,852,108.10,649,108.40,629,108.84,685,109.62,617,110.42,715,110.67,715,111.66,629,112.28,916,112.87,531,112.18,357,112.36,917,112.16,828,111.49,708,111.25,858,111.36,775,111.74,785,111.10,1006,111.33,789,111.25,734,111.04,906,110.97,532,111.31,387,111.02,991,111.07,841,111.36,892,111.54,782),dim=c(2,72),dimnames=list(c('CPI','Faillissementen'),1:72))
> y <- array(NA,dim=c(2,72),dimnames=list(c('CPI','Faillissementen'),1:72))
> 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 = 'Do not include Seasonal 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
Faillissementen CPI
1 627 98.60
2 696 98.97
3 825 99.11
4 677 99.64
5 656 100.03
6 785 99.98
7 412 100.32
8 352 100.44
9 839 100.51
10 729 101.00
11 696 100.88
12 641 100.55
13 695 100.83
14 638 101.51
15 762 102.16
16 635 102.39
17 721 102.54
18 854 102.85
19 418 103.47
20 367 103.57
21 824 103.69
22 687 103.50
23 601 103.47
24 676 103.45
25 740 103.48
26 691 103.93
27 683 103.89
28 594 104.40
29 729 104.79
30 731 104.77
31 386 105.13
32 331 105.26
33 707 104.96
34 715 104.75
35 657 105.01
36 653 105.15
37 642 105.20
38 643 105.77
39 718 105.78
40 654 106.26
41 632 106.13
42 731 106.12
43 392 106.57
44 344 106.44
45 792 106.54
46 852 107.10
47 649 108.10
48 629 108.40
49 685 108.84
50 617 109.62
51 715 110.42
52 715 110.67
53 629 111.66
54 916 112.28
55 531 112.87
56 357 112.18
57 917 112.36
58 828 112.16
59 708 111.49
60 858 111.25
61 775 111.36
62 785 111.74
63 1006 111.10
64 789 111.33
65 734 111.25
66 906 111.04
67 532 110.97
68 387 111.31
69 991 111.02
70 841 111.07
71 892 111.36
72 782 111.54
> k <- length(x[1,])
> df <- as.data.frame(x)
> (mylm <- lm(df))
Call:
lm(formula = df)
Coefficients:
(Intercept) CPI
-150.169 7.831
> (mysum <- summary(mylm))
Call:
lm(formula = df)
Residuals:
Min 1Q Median 3Q Max
-371.32 -47.77 24.74 81.91 286.13
Coefficients:
Estimate Std. Error t value Pr(>|t|)
(Intercept) -150.169 453.796 -0.331 0.7417
CPI 7.831 4.274 1.832 0.0712 .
---
Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
Residual standard error: 154 on 70 degrees of freedom
Multiple R-squared: 0.04576, Adjusted R-squared: 0.03213
F-statistic: 3.357 on 1 and 70 DF, p-value: 0.07118
> 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.18479953 0.36959907 0.8152005
[2,] 0.11957506 0.23915012 0.8804249
[3,] 0.40633624 0.81267247 0.5936638
[4,] 0.51290320 0.97419360 0.4870968
[5,] 0.73668638 0.52662724 0.2633136
[6,] 0.70542021 0.58915958 0.2945798
[7,] 0.62657860 0.74684280 0.3734214
[8,] 0.52822219 0.94355561 0.4717778
[9,] 0.44407976 0.88815952 0.5559202
[10,] 0.35251882 0.70503763 0.6474812
[11,] 0.32194261 0.64388522 0.6780574
[12,] 0.24788203 0.49576405 0.7521180
[13,] 0.19572415 0.39144829 0.8042759
[14,] 0.22455720 0.44911439 0.7754428
[15,] 0.35753731 0.71507462 0.6424627
[16,] 0.48660468 0.97320937 0.5133953
[17,] 0.55404930 0.89190139 0.4459507
[18,] 0.48798814 0.97597627 0.5120119
[19,] 0.41559624 0.83119247 0.5844038
[20,] 0.35049028 0.70098056 0.6495097
[21,] 0.31699381 0.63398762 0.6830062
[22,] 0.26318170 0.52636340 0.7368183
[23,] 0.21337560 0.42675120 0.7866244
[24,] 0.16853899 0.33707799 0.8314610
[25,] 0.14253929 0.28507859 0.8574607
[26,] 0.11990003 0.23980007 0.8801000
[27,] 0.19390058 0.38780115 0.8060994
[28,] 0.34393121 0.68786242 0.6560688
[29,] 0.30291545 0.60583090 0.6970846
[30,] 0.26645210 0.53290421 0.7335479
[31,] 0.21533410 0.43066821 0.7846659
[32,] 0.16991711 0.33983422 0.8300829
[33,] 0.13026650 0.26053300 0.8697335
[34,] 0.09756502 0.19513004 0.9024350
[35,] 0.08062114 0.16124228 0.9193789
[36,] 0.05842661 0.11685323 0.9415734
[37,] 0.04079422 0.08158844 0.9592058
[38,] 0.03425190 0.06850380 0.9657481
[39,] 0.05525083 0.11050166 0.9447492
[40,] 0.14476468 0.28952937 0.8552353
[41,] 0.13670363 0.27340727 0.8632964
[42,] 0.16165863 0.32331726 0.8383414
[43,] 0.12373839 0.24747679 0.8762616
[44,] 0.09645235 0.19290471 0.9035476
[45,] 0.07402226 0.14804451 0.9259777
[46,] 0.06992941 0.13985882 0.9300706
[47,] 0.05645029 0.11290059 0.9435497
[48,] 0.04476668 0.08953336 0.9552333
[49,] 0.03454252 0.06908504 0.9654575
[50,] 0.05912634 0.11825267 0.9408737
[51,] 0.04697330 0.09394661 0.9530267
[52,] 0.22595702 0.45191404 0.7740430
[53,] 0.24173359 0.48346717 0.7582664
[54,] 0.21331112 0.42662224 0.7866889
[55,] 0.15941251 0.31882502 0.8405875
[56,] 0.12913733 0.25827466 0.8708627
[57,] 0.08797591 0.17595183 0.9120241
[58,] 0.06030088 0.12060175 0.9396991
[59,] 0.09109577 0.18219154 0.9089042
[60,] 0.05628865 0.11257731 0.9437113
[61,] 0.03034077 0.06068153 0.9696592
[62,] 0.02296293 0.04592587 0.9770371
[63,] 0.04308552 0.08617104 0.9569145
> postscript(file="/var/www/html/rcomp/tmp/1aor11291124201.ps",horizontal=F,onefile=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/2aor11291124201.ps",horizontal=F,onefile=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/3lf841291124201.ps",horizontal=F,onefile=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/4lf841291124201.ps",horizontal=F,onefile=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/5lf841291124201.ps",horizontal=F,onefile=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 = 72
Frequency = 1
1 2 3 4 5 6
5.0220741 71.1245672 199.0282132 46.8777302 22.8236013 152.2151563
7 8 9 10 11 12
-223.4474177 -284.3871497 202.0646733 88.2274344 56.1671663 3.7514293
13 14 15 16 17 18
55.5587213 -6.7664266 112.1433585 -16.6577945 68.1675405 198.7398995
19 20 21 22 23 24
-242.1153824 -293.8984924 162.1617756 26.6496846 -59.1153824 16.0412396
25 26 27 28 29 30
79.8063066 27.2823116 19.5955556 -73.3983053 58.5475657 60.7041877
31 32 33 34 35 36
-287.1150083 -343.1330512 35.2162787 44.8608097 -15.1752763 -20.2716303
37 38 39 40 41 42
-31.6631853 -35.1269122 39.7947768 -27.9641512 -48.9461082 50.1322028
43 44 45 46 47 48
-292.3917921 -339.3737491 107.8431409 163.4577249 -47.3733750 -69.7227049
49 50 51 52 53 54
-17.1683889 -91.2766468 0.4584732 -1.4993017 -95.2520906 186.8926274
55 56 57 58 59 60
-202.7277215 -371.3242626 187.2661394 99.8323594 -14.9208037 136.9586603
61 62 63 64 65 66
53.0972393 60.1214214 286.1333253 67.3321723 12.9586603 186.6031913
67 68 69 70 71 72
-186.8486317 -334.5112057 271.7598133 121.3682583 170.0972393 58.6876413
> postscript(file="/var/www/html/rcomp/tmp/6w6771291124201.ps",horizontal=F,onefile=F,pagecentre=F,paper="special",width=8.3333333333333,height=5.5555555555556)
> dum <- cbind(lag(myerror,k=1),myerror)
> dum
Time Series:
Start = 0
End = 72
Frequency = 1
lag(myerror, k = 1) myerror
0 5.0220741 NA
1 71.1245672 5.0220741
2 199.0282132 71.1245672
3 46.8777302 199.0282132
4 22.8236013 46.8777302
5 152.2151563 22.8236013
6 -223.4474177 152.2151563
7 -284.3871497 -223.4474177
8 202.0646733 -284.3871497
9 88.2274344 202.0646733
10 56.1671663 88.2274344
11 3.7514293 56.1671663
12 55.5587213 3.7514293
13 -6.7664266 55.5587213
14 112.1433585 -6.7664266
15 -16.6577945 112.1433585
16 68.1675405 -16.6577945
17 198.7398995 68.1675405
18 -242.1153824 198.7398995
19 -293.8984924 -242.1153824
20 162.1617756 -293.8984924
21 26.6496846 162.1617756
22 -59.1153824 26.6496846
23 16.0412396 -59.1153824
24 79.8063066 16.0412396
25 27.2823116 79.8063066
26 19.5955556 27.2823116
27 -73.3983053 19.5955556
28 58.5475657 -73.3983053
29 60.7041877 58.5475657
30 -287.1150083 60.7041877
31 -343.1330512 -287.1150083
32 35.2162787 -343.1330512
33 44.8608097 35.2162787
34 -15.1752763 44.8608097
35 -20.2716303 -15.1752763
36 -31.6631853 -20.2716303
37 -35.1269122 -31.6631853
38 39.7947768 -35.1269122
39 -27.9641512 39.7947768
40 -48.9461082 -27.9641512
41 50.1322028 -48.9461082
42 -292.3917921 50.1322028
43 -339.3737491 -292.3917921
44 107.8431409 -339.3737491
45 163.4577249 107.8431409
46 -47.3733750 163.4577249
47 -69.7227049 -47.3733750
48 -17.1683889 -69.7227049
49 -91.2766468 -17.1683889
50 0.4584732 -91.2766468
51 -1.4993017 0.4584732
52 -95.2520906 -1.4993017
53 186.8926274 -95.2520906
54 -202.7277215 186.8926274
55 -371.3242626 -202.7277215
56 187.2661394 -371.3242626
57 99.8323594 187.2661394
58 -14.9208037 99.8323594
59 136.9586603 -14.9208037
60 53.0972393 136.9586603
61 60.1214214 53.0972393
62 286.1333253 60.1214214
63 67.3321723 286.1333253
64 12.9586603 67.3321723
65 186.6031913 12.9586603
66 -186.8486317 186.6031913
67 -334.5112057 -186.8486317
68 271.7598133 -334.5112057
69 121.3682583 271.7598133
70 170.0972393 121.3682583
71 58.6876413 170.0972393
72 NA 58.6876413
> dum1 <- dum[2:length(myerror),]
> dum1
lag(myerror, k = 1) myerror
[1,] 71.1245672 5.0220741
[2,] 199.0282132 71.1245672
[3,] 46.8777302 199.0282132
[4,] 22.8236013 46.8777302
[5,] 152.2151563 22.8236013
[6,] -223.4474177 152.2151563
[7,] -284.3871497 -223.4474177
[8,] 202.0646733 -284.3871497
[9,] 88.2274344 202.0646733
[10,] 56.1671663 88.2274344
[11,] 3.7514293 56.1671663
[12,] 55.5587213 3.7514293
[13,] -6.7664266 55.5587213
[14,] 112.1433585 -6.7664266
[15,] -16.6577945 112.1433585
[16,] 68.1675405 -16.6577945
[17,] 198.7398995 68.1675405
[18,] -242.1153824 198.7398995
[19,] -293.8984924 -242.1153824
[20,] 162.1617756 -293.8984924
[21,] 26.6496846 162.1617756
[22,] -59.1153824 26.6496846
[23,] 16.0412396 -59.1153824
[24,] 79.8063066 16.0412396
[25,] 27.2823116 79.8063066
[26,] 19.5955556 27.2823116
[27,] -73.3983053 19.5955556
[28,] 58.5475657 -73.3983053
[29,] 60.7041877 58.5475657
[30,] -287.1150083 60.7041877
[31,] -343.1330512 -287.1150083
[32,] 35.2162787 -343.1330512
[33,] 44.8608097 35.2162787
[34,] -15.1752763 44.8608097
[35,] -20.2716303 -15.1752763
[36,] -31.6631853 -20.2716303
[37,] -35.1269122 -31.6631853
[38,] 39.7947768 -35.1269122
[39,] -27.9641512 39.7947768
[40,] -48.9461082 -27.9641512
[41,] 50.1322028 -48.9461082
[42,] -292.3917921 50.1322028
[43,] -339.3737491 -292.3917921
[44,] 107.8431409 -339.3737491
[45,] 163.4577249 107.8431409
[46,] -47.3733750 163.4577249
[47,] -69.7227049 -47.3733750
[48,] -17.1683889 -69.7227049
[49,] -91.2766468 -17.1683889
[50,] 0.4584732 -91.2766468
[51,] -1.4993017 0.4584732
[52,] -95.2520906 -1.4993017
[53,] 186.8926274 -95.2520906
[54,] -202.7277215 186.8926274
[55,] -371.3242626 -202.7277215
[56,] 187.2661394 -371.3242626
[57,] 99.8323594 187.2661394
[58,] -14.9208037 99.8323594
[59,] 136.9586603 -14.9208037
[60,] 53.0972393 136.9586603
[61,] 60.1214214 53.0972393
[62,] 286.1333253 60.1214214
[63,] 67.3321723 286.1333253
[64,] 12.9586603 67.3321723
[65,] 186.6031913 12.9586603
[66,] -186.8486317 186.6031913
[67,] -334.5112057 -186.8486317
[68,] 271.7598133 -334.5112057
[69,] 121.3682583 271.7598133
[70,] 170.0972393 121.3682583
[71,] 58.6876413 170.0972393
> z <- as.data.frame(dum1)
> z
lag(myerror, k = 1) myerror
1 71.1245672 5.0220741
2 199.0282132 71.1245672
3 46.8777302 199.0282132
4 22.8236013 46.8777302
5 152.2151563 22.8236013
6 -223.4474177 152.2151563
7 -284.3871497 -223.4474177
8 202.0646733 -284.3871497
9 88.2274344 202.0646733
10 56.1671663 88.2274344
11 3.7514293 56.1671663
12 55.5587213 3.7514293
13 -6.7664266 55.5587213
14 112.1433585 -6.7664266
15 -16.6577945 112.1433585
16 68.1675405 -16.6577945
17 198.7398995 68.1675405
18 -242.1153824 198.7398995
19 -293.8984924 -242.1153824
20 162.1617756 -293.8984924
21 26.6496846 162.1617756
22 -59.1153824 26.6496846
23 16.0412396 -59.1153824
24 79.8063066 16.0412396
25 27.2823116 79.8063066
26 19.5955556 27.2823116
27 -73.3983053 19.5955556
28 58.5475657 -73.3983053
29 60.7041877 58.5475657
30 -287.1150083 60.7041877
31 -343.1330512 -287.1150083
32 35.2162787 -343.1330512
33 44.8608097 35.2162787
34 -15.1752763 44.8608097
35 -20.2716303 -15.1752763
36 -31.6631853 -20.2716303
37 -35.1269122 -31.6631853
38 39.7947768 -35.1269122
39 -27.9641512 39.7947768
40 -48.9461082 -27.9641512
41 50.1322028 -48.9461082
42 -292.3917921 50.1322028
43 -339.3737491 -292.3917921
44 107.8431409 -339.3737491
45 163.4577249 107.8431409
46 -47.3733750 163.4577249
47 -69.7227049 -47.3733750
48 -17.1683889 -69.7227049
49 -91.2766468 -17.1683889
50 0.4584732 -91.2766468
51 -1.4993017 0.4584732
52 -95.2520906 -1.4993017
53 186.8926274 -95.2520906
54 -202.7277215 186.8926274
55 -371.3242626 -202.7277215
56 187.2661394 -371.3242626
57 99.8323594 187.2661394
58 -14.9208037 99.8323594
59 136.9586603 -14.9208037
60 53.0972393 136.9586603
61 60.1214214 53.0972393
62 286.1333253 60.1214214
63 67.3321723 286.1333253
64 12.9586603 67.3321723
65 186.6031913 12.9586603
66 -186.8486317 186.6031913
67 -334.5112057 -186.8486317
68 271.7598133 -334.5112057
69 121.3682583 271.7598133
70 170.0972393 121.3682583
71 58.6876413 170.0972393
> 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/7og7a1291124201.ps",horizontal=F,onefile=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/8og7a1291124201.ps",horizontal=F,onefile=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/9og7a1291124201.ps",horizontal=F,onefile=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/10z7od1291124201.ps",horizontal=F,onefile=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/11274j1291124201.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/12o8lo1291124201.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/13kijx1291124201.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/14n0zl1291124201.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/15rjfr1291124201.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/16c1wf1291124201.tab")
+ }
>
> try(system("convert tmp/1aor11291124201.ps tmp/1aor11291124201.png",intern=TRUE))
character(0)
> try(system("convert tmp/2aor11291124201.ps tmp/2aor11291124201.png",intern=TRUE))
character(0)
> try(system("convert tmp/3lf841291124201.ps tmp/3lf841291124201.png",intern=TRUE))
character(0)
> try(system("convert tmp/4lf841291124201.ps tmp/4lf841291124201.png",intern=TRUE))
character(0)
> try(system("convert tmp/5lf841291124201.ps tmp/5lf841291124201.png",intern=TRUE))
character(0)
> try(system("convert tmp/6w6771291124201.ps tmp/6w6771291124201.png",intern=TRUE))
character(0)
> try(system("convert tmp/7og7a1291124201.ps tmp/7og7a1291124201.png",intern=TRUE))
character(0)
> try(system("convert tmp/8og7a1291124201.ps tmp/8og7a1291124201.png",intern=TRUE))
character(0)
> try(system("convert tmp/9og7a1291124201.ps tmp/9og7a1291124201.png",intern=TRUE))
character(0)
> try(system("convert tmp/10z7od1291124201.ps tmp/10z7od1291124201.png",intern=TRUE))
character(0)
>
>
> proc.time()
user system elapsed
2.677 1.720 6.930