Send output to:
Browser Blue - Charts White
Browser Black/White
CSV
Data X:
66 4818 4488 5 73 68 0 4964 1 54 3132 2916 12 58 54 1 3132 1 82 5576 3362 11 68 41 1 2788 1 61 3782 2989 6 62 49 1 3038 1 65 4225 3185 12 65 49 1 3185 1 77 6237 5544 11 81 72 1 5832 1 66 4818 5148 12 73 78 1 5694 1 66 4224 3828 7 64 58 0 3712 1 66 4488 3828 8 68 58 1 3944 1 48 2448 1104 13 51 23 1 1173 1 57 3876 2223 12 68 39 1 2652 1 80 4880 5040 13 61 63 1 3843 1 60 4140 2760 12 69 46 1 3174 1 70 5110 4060 12 73 58 1 4234 1 85 5185 3315 11 61 39 0 2379 1 59 3658 2596 12 62 44 0 2728 1 72 4536 3528 12 63 49 1 3087 1 70 4830 3990 12 69 57 1 3933 1 74 3478 5624 11 47 76 0 3572 1 70 4620 4410 13 66 63 0 4158 1 51 2958 918 9 58 18 1 1044 1 70 4410 2800 11 63 40 0 2520 1 71 4899 4189 11 69 59 1 4071 1 72 4248 4464 11 59 62 0 3658 1 50 2950 3500 9 59 70 1 4130 1 69 4347 4485 11 63 65 0 4095 1 73 4745 4088 12 65 56 0 3640 1 66 4290 2970 12 65 45 1 2925 1 73 5183 4161 10 71 57 0 4047 1 58 3480 2900 12 60 50 1 3000 1 78 6318 3120 12 81 40 0 3240 1 83 5561 4814 12 67 58 1 3886 1 76 5016 3724 9 66 49 0 3234 1 77 4774 3773 9 62 49 1 3038 1 79 4977 2133 12 63 27 1 1701 1 71 5183 3621 14 73 51 0 3723 1 79 4345 5925 12 55 75 0 4125 1 60 3540 3900 11 59 65 1 3835 1 73 4672 3431 9 64 47 1 3008 1 70 4410 3430 11 63 49 0 3087 1 42 2688 2730 7 64 65 1 4160 1 74 5402 4514 15 73 61 1 4453 1 68 3672 3128 11 54 46 1 2484 1 83 6308 5727 12 76 69 1 5244 1 62 4588 3410 12 74 55 0 4070 1 79 4977 6162 9 63 78 0 4914 1 61 4453 3538 12 73 58 0 4234 1 86 5762 2924 11 67 34 0 2278 1 64 4352 4288 11 68 67 0 4556 1 75 4950 3375 8 66 45 1 2970 1 59 3658 4012 7 62 68 0 4216 1 82 5822 4018 12 71 49 0 3479 1 61 3843 1159 8 63 19 1 1197 1 69 5175 4968 10 75 72 1 5400 1 60 4620 3540 12 77 59 1 4543 1 59 3658 2714 15 62 46 0 2852 1 81 5994 4536 12 74 56 1 4144 1 65 4355 2925 12 67 45 0 3015 1 60 3360 3180 12 56 53 0 2968 1 60 3600 4020 12 60 67 0 4020 1 45 2610 3285 8 58 73 0 4234 1 75 4875 3450 10 65 46 1 2990 1 84 4116 5880 14 49 70 0 3430 1 77 4697 2926 10 61 38 1 2318 1 64 4224 3456 12 66 54 0 3564 1 54 3456 2484 14 64 46 0 2944 1 72 4680 3312 6 65 46 0 2990 1 56 2576 2520 11 46 45 1 2070 1 67 4355 3149 10 65 47 0 3055 1 81 6561 2025 14 81 25 0 2025 1 73 5256 4599 12 72 63 1 4536 1 67 4355 3082 13 65 46 0 2990 1 72 5328 4968 11 74 69 0 5106 1 69 4071 2967 11 59 43 1 2537 1 71 4899 3479 12 69 49 1 3381 1 77 4466 3003 13 58 39 0 2262 1 63 4473 4095 12 71 65 1 4615 1 49 3871 2646 8 79 54 0 4266 1 74 5032 3700 12 68 50 0 3400 1 76 5016 3192 11 66 42 1 2772 1 65 4030 2925 10 62 45 0 2790 1 65 4485 3250 12 69 50 1 3450 1 69 4347 3795 11 63 55 0 3465 1 71 4402 2698 12 62 38 1 2356 1 68 4148 2720 12 61 40 1 2440 1 49 3185 2499 10 65 51 0 3315 1 86 5504 4214 12 64 49 1 3136 1 63 3528 2457 12 56 39 0 2184 1 77 4312 4389 11 56 57 0 3192 1 52 2496 1560 10 48 30 1 1440 1 73 5402 3723 12 74 51 1 3774 1 63 4347 3024 11 69 48 1 3312 1 54 3348 3024 12 62 56 1 3472 1 56 4088 3696 12 73 66 1 4818 1 54 3456 3888 10 64 72 1 4608 1 61 3477 1708 11 57 28 1 1596 1 70 3990 3640 10 57 52 1 2964 1 68 4080 3604 11 60 53 0 3180 1 63 3843 4410 11 61 70 0 4270 1 76 5472 4788 12 72 63 1 4536 1 69 3933 3174 11 57 46 1 2622 1 71 3621 3195 11 51 45 1 2295 1 39 2457 2652 7 63 68 1 4284 2 54 2916 2916 12 54 54 1 2916 1 64 4608 3840 8 72 60 1 4320 2 70 4340 3500 10 62 50 1 3100 1 76 5168 5016 12 68 66 1 4488 1 71 4402 3976 11 62 56 1 3472 1 73 4599 3942 13 63 54 0 3402 1 81 6237 5832 9 77 72 1 5544 1 50 2850 1700 11 57 34 1 1938 1 42 2394 1638 13 57 39 1 2223 1 66 4026 4356 8 61 66 1 4026 1 77 5005 2079 12 65 27 1 1755 1 62 3906 3906 11 63 63 1 3969 1 66 4356 4290 11 66 65 0 4290 1 69 4692 4347 12 68 63 1 4284 1 72 5184 3528 13 72 49 1 3528 1 67 4556 2814 11 68 42 1 2856 1 59 3481 3009 10 59 51 1 3009 1 66 3696 3300 10 56 50 1 2800 1 68 4216 4352 10 62 64 1 3968 1 72 5184 4896 12 72 68 0 4896 1 73 4964 4818 12 68 66 0 4488 1 69 4623 4071 13 67 59 1 3953 1 57 3078 1824 11 54 32 1 1728 1 55 3795 3410 11 69 62 0 4278 1 72 4392 3744 12 61 52 1 3172 1 68 3740 2312 9 55 34 1 1870 1 83 6225 5229 11 75 63 0 4725 1 74 4070 3552 12 55 48 1 2640 1 72 3528 3816 12 49 53 1 2597 1 66 3564 2574 13 54 39 0 2106 1 61 4026 3111 6 66 51 1 3366 1 86 6278 5160 11 73 60 1 4380 1 81 5103 5670 10 63 70 0 4410 1 79 4819 3160 12 61 40 0 2440 1 73 5402 4453 11 74 61 1 4514 1 59 4779 2065 12 81 35 0 2835 1 64 3968 2496 12 62 39 1 2418 1 75 4800 2325 7 64 31 1 1984 1 68 4216 2448 12 62 36 1 2232 1 84 7140 4284 12 85 51 1 4335 1 68 5032 3740 9 74 55 1 4070 1 68 3468 4556 12 51 67 1 3417 1 69 4554 2760 12 66 40 1 2640 1
Names of X columns:
Groepsgevoel InteractieGR_NV InteractieGR_U Vrienden_vinden NVC Uitingsangst Geslacht InteractieNV_U Leeftijd
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
No 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
0 seconds
R Server
Big Analytics Cloud Computing Center
Click here to blog (archive) this computation