Send output to:
Browser Blue - Charts White
Browser Black/White
CSV
Data X:
66 4964 4818 4488 5 73 68 54 3132 3132 2916 12 58 54 82 2788 5576 3362 11 68 41 61 3038 3782 2989 6 62 49 65 3185 4225 3185 12 65 49 77 5832 6237 5544 11 81 72 66 5694 4818 5148 12 73 78 66 3712 4224 3828 7 64 58 66 3944 4488 3828 8 68 58 48 1173 2448 1104 13 51 23 57 2652 3876 2223 12 68 39 80 3843 4880 5040 13 61 63 60 3174 4140 2760 12 69 46 70 4234 5110 4060 12 73 58 85 2379 5185 3315 11 61 39 59 2728 3658 2596 12 62 44 72 3087 4536 3528 12 63 49 70 3933 4830 3990 12 69 57 74 3572 3478 5624 11 47 76 70 4158 4620 4410 13 66 63 51 1044 2958 918 9 58 18 70 2520 4410 2800 11 63 40 71 4071 4899 4189 11 69 59 72 3658 4248 4464 11 59 62 50 4130 2950 3500 9 59 70 69 4095 4347 4485 11 63 65 73 3640 4745 4088 12 65 56 66 2925 4290 2970 12 65 45 73 4047 5183 4161 10 71 57 58 3000 3480 2900 12 60 50 78 3240 6318 3120 12 81 40 83 3886 5561 4814 12 67 58 76 3234 5016 3724 9 66 49 77 3038 4774 3773 9 62 49 79 1701 4977 2133 12 63 27 71 3723 5183 3621 14 73 51 79 4125 4345 5925 12 55 75 60 3835 3540 3900 11 59 65 73 3008 4672 3431 9 64 47 70 3087 4410 3430 11 63 49 42 4160 2688 2730 7 64 65 74 4453 5402 4514 15 73 61 68 2484 3672 3128 11 54 46 83 5244 6308 5727 12 76 69 62 4070 4588 3410 12 74 55 79 4914 4977 6162 9 63 78 61 4234 4453 3538 12 73 58 86 2278 5762 2924 11 67 34 64 4556 4352 4288 11 68 67 75 2970 4950 3375 8 66 45 59 4216 3658 4012 7 62 68 82 3479 5822 4018 12 71 49 61 1197 3843 1159 8 63 19 69 5400 5175 4968 10 75 72 60 4543 4620 3540 12 77 59 59 2852 3658 2714 15 62 46 81 4144 5994 4536 12 74 56 65 3015 4355 2925 12 67 45 60 2968 3360 3180 12 56 53 60 4020 3600 4020 12 60 67 45 4234 2610 3285 8 58 73 75 2990 4875 3450 10 65 46 84 3430 4116 5880 14 49 70 77 2318 4697 2926 10 61 38 64 3564 4224 3456 12 66 54 54 2944 3456 2484 14 64 46 72 2990 4680 3312 6 65 46 56 2070 2576 2520 11 46 45 67 3055 4355 3149 10 65 47 81 2025 6561 2025 14 81 25 73 4536 5256 4599 12 72 63 67 2990 4355 3082 13 65 46 72 5106 5328 4968 11 74 69 69 2537 4071 2967 11 59 43 71 3381 4899 3479 12 69 49 77 2262 4466 3003 13 58 39 63 4615 4473 4095 12 71 65 49 4266 3871 2646 8 79 54 74 3400 5032 3700 12 68 50 76 2772 5016 3192 11 66 42 65 2790 4030 2925 10 62 45 65 3450 4485 3250 12 69 50 69 3465 4347 3795 11 63 55 71 2356 4402 2698 12 62 38 68 2440 4148 2720 12 61 40 49 3315 3185 2499 10 65 51 86 3136 5504 4214 12 64 49 63 2184 3528 2457 12 56 39 77 3192 4312 4389 11 56 57 52 1440 2496 1560 10 48 30 73 3774 5402 3723 12 74 51 63 3312 4347 3024 11 69 48 54 3472 3348 3024 12 62 56 56 4818 4088 3696 12 73 66 54 4608 3456 3888 10 64 72 61 1596 3477 1708 11 57 28 70 2964 3990 3640 10 57 52 68 3180 4080 3604 11 60 53 63 4270 3843 4410 11 61 70 76 4536 5472 4788 12 72 63 69 2622 3933 3174 11 57 46 71 2295 3621 3195 11 51 45 39 4284 2457 2652 7 63 68 54 2916 2916 2916 12 54 54 64 4320 4608 3840 8 72 60 70 3100 4340 3500 10 62 50 76 4488 5168 5016 12 68 66 71 3472 4402 3976 11 62 56 73 3402 4599 3942 13 63 54 81 5544 6237 5832 9 77 72 50 1938 2850 1700 11 57 34 42 2223 2394 1638 13 57 39 66 4026 4026 4356 8 61 66 77 1755 5005 2079 12 65 27 62 3969 3906 3906 11 63 63 66 4290 4356 4290 11 66 65 69 4284 4692 4347 12 68 63 72 3528 5184 3528 13 72 49 67 2856 4556 2814 11 68 42 59 3009 3481 3009 10 59 51 66 2800 3696 3300 10 56 50 68 3968 4216 4352 10 62 64 72 4896 5184 4896 12 72 68 73 4488 4964 4818 12 68 66 69 3953 4623 4071 13 67 59 57 1728 3078 1824 11 54 32 55 4278 3795 3410 11 69 62 72 3172 4392 3744 12 61 52 68 1870 3740 2312 9 55 34 83 4725 6225 5229 11 75 63 74 2640 4070 3552 12 55 48 72 2597 3528 3816 12 49 53 66 2106 3564 2574 13 54 39 61 3366 4026 3111 6 66 51 86 4380 6278 5160 11 73 60 81 4410 5103 5670 10 63 70 79 2440 4819 3160 12 61 40 73 4514 5402 4453 11 74 61 59 2835 4779 2065 12 81 35 64 2418 3968 2496 12 62 39 75 1984 4800 2325 7 64 31 68 2232 4216 2448 12 62 36 84 4335 7140 4284 12 85 51 68 4070 5032 3740 9 74 55 68 3417 3468 4556 12 51 67 69 2640 4554 2760 12 66 40
Names of X columns:
Groepsgevoel InteractieNV-U InteractieGR_NV interacteiGR_U Vrienden_vinden NV Uitingsangst
Sample Range:
(leave blank to include all observations)
From:
To:
Column Number of Endogenous Series
(?)
Fixed Seasonal Effects
Do not include Seasonal Dummies
Do not include Seasonal Dummies
Include Seasonal Dummies
Type of Equation
Linear Trend
No Linear Trend
Linear Trend
First Differences
Seasonal Differences (s)
First and Seasonal Differences (s)
Degree of Predetermination (lagged endogenous variables)
Degree of Seasonal Predetermination
Seasonality
12
1
2
3
4
5
6
7
8
9
10
11
12
Chart options
R Code
library(lattice) library(lmtest) 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 k <- length(x[1,]) df <- as.data.frame(x) (mylm <- lm(df)) (mysum <- summary(mylm)) 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 } bitmap(file='test0.png') 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() bitmap(file='test1.png') plot(mysum$resid, type='b', pch=19, main='Residuals', ylab='value of Residuals', xlab='time or index') grid() dev.off() bitmap(file='test2.png') hist(mysum$resid, main='Residual Histogram', xlab='values of Residuals') grid() dev.off() bitmap(file='test3.png') densityplot(~mysum$resid,col='black',main='Residual Density Plot', xlab='values of Residuals') dev.off() bitmap(file='test4.png') qqnorm(mysum$resid, main='Residual Normal Q-Q Plot') qqline(mysum$resid) grid() dev.off() (myerror <- as.ts(mysum$resid)) bitmap(file='test5.png') dum <- cbind(lag(myerror,k=1),myerror) dum dum1 <- dum[2:length(myerror),] dum1 z <- as.data.frame(dum1) z 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() bitmap(file='test6.png') acf(mysum$resid, lag.max=length(mysum$resid)/2, main='Residual Autocorrelation Function') grid() dev.off() bitmap(file='test7.png') pacf(mysum$resid, lag.max=length(mysum$resid)/2, main='Residual Partial Autocorrelation Function') grid() dev.off() bitmap(file='test8.png') opar <- par(mfrow = c(2,2), oma = c(0, 0, 1.1, 0)) plot(mylm, las = 1, sub='Residual Diagnostics') par(opar) dev.off() if (n > n25) { bitmap(file='test9.png') plot(kp3:nmkm3,gqarr[,2], main='Goldfeld-Quandt test',ylab='2-sided p-value',xlab='breakpoint') grid() dev.off() } load(file='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='mytable1.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<br />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='mytable2.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='mytable3.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<br />Forecast', 1, TRUE) a<-table.element(a, 'Residuals<br />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='mytable4.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='mytable5.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='mytable6.tab') }
Compute
Summary of computational transaction
Raw Input
view raw input (R code)
Raw Output
view raw output of R engine
Computing time
1 seconds
R Server
Big Analytics Cloud Computing Center
Click here to blog (archive) this computation