Wessa.net

Send output to:

Data X:
39411 50149 82368 86371 111549 61484 70774 50982 40320 29520 58186 77795 90085 110697 61165 71212 51083 40329 31187 56275 62827 97462 108155 61172 71222 51161 40338 27463 52302 67197 98688 107545 59987 70806 50403 39814 28454 50332 66848 97734 107665 59999 70973 50853 39917 37250 47451 66421 94153 106314 59725 70852 50925 39851 69891 56251 60643 96705 111233 60989 72216 51460 40179 44435 91027 59071 93928 106930 66174 72229 51834 40181 52881 82777 58746 84753 108570 66616 73494 52045 40034 37948 73833 68515 76817 99293 68211 71846 51561 39601 28454 70024 68998 73779 96278 67105 70240 51626 39238 26285 54075 77614 75180 96179 66070 70588 51950 39333 36510 44376 73469 79710 98383 65933 70348 52599 39248 28179 49188 67145 80768 97265 64796 69876 52666 38971 29811 50930 51109 84924 92909 62341 68633 52416 38600 26553 47574 51130 88760 91516 61741 68081 52217 38347 26844 44963 49544 83140 89132 60415 66758 52339 37903 37692 42243 50730 74597 83006 57218 64609 51327 37240 74285 52678 49710 77269 87435 58594 65469 52572 37350 43479 92780 50059 75494 88227 54904 69288 53103 37257 51359 77386 49681 66254 85180 54053 67793 53106 36845 39988 67733 65773 61533 83531 49856 68855 53373 36428 28764 68127 66129 60383 80735 48894 66599 54023 36192 27567 56378 78039 65317 80067 49807 66295 54628 36160 39367 44420 71278 75500 79288 50475 65336 55135 36123 30110 51304 65862 77400 77580 50067 64382 55005 35851 28281 52963 51540 83048 75286 48500 62741 54838 35425 29968 45032 51513 88294 74919 47827 62331 55083 35276 24942 44353 49740 82431 72120 46114 60506 54321 34830 37122 43362 50980 77941 72916 45840 60182 54532 34705 66852 52722 51294 78948 80984 47138 60574 55167 34700 40973 86193 49719 77560 82160 46694 60386 55298 34607 55967 68245 50673 68186 80492 45419 59413 55248 34302 41569 69196 59191 64398 80240 44489 58195 54917 33979 30936 74491 61807 63494 80373 43776 58143 54943 33903 35059 60455 77687 69750 81710 43422 58594 55558 33906 43354 53798 77227 76441 85125 43096 59386 55887 33908 36918 62933 75594 79363 86198 42897 58887 56048 33800 40761 63956 64158 90780 85910 42681 57940 56485 33651 33552 62346 64551 97287 87804 42818 57676 56913 33588 29219 58923 65143 94922 86309 42214 56738 56688 33441 41201 52204 69958 94710 88113 42889 56552 57052 33535 70480 60898 68154 99073 91819 47416 57320 57741 33669 43943 96693 64628 100853 93407 48210 54838 60372 33650 59389 77922 61690 92333 94296 47881 53709 59892 33411 40877 77626 71412 86620 94697 47839 50993 61114 33300 32805 79173 73606 84634 94858 47972 50391 60891 33230 30211 65251 91586 92309 100812 49424 50777 61394 33329 43514 54488 85299 96796 102621 50974 51163 61766 33491 34397 62042 81752 96349 103623 51210 50467 61432 33489 38403 61147 63479 102177 103635 50787 49380 60918 33324 31352 58698 62470 103298 102282 51027 48509 60783 33112 28815 56236 60452 99765 99824 50307 48100 60447 33088 39825 49879 65593 95187 100879 51061 48507 60583 33172 68608 61076 64223 99110 108320 52409 52335 61451 33459 48668 92317 61466 96585 106920 51928 51952 61110 33432 59004 79439 58471 85981 104997 52302 51628 60920 33369 39263 79951 67261 79250 100786 52255 51480 60251 33171 31014 76304 71826 76175 98170 51683 50582 59828 33022 30275 59409 84695 81079 98420 53376 50793 60055 33072 42170 51241 80558 85030 98477 54110 50982 60184 32902 33765 59166 73755 87331 96166 54198 50986 59812 32791 34792 60574 57786 94717 94833 54486 50979 59315 32842 30210 55326 59266 96502 92590 53976 51039 58857 32811 33898 50832 58815 92301 90143 53123 50438 58330 32699 36051 50871 60945 86797 89674 52825 50647 58100 32744 66049 59889 58520 92556 95661 55079 52947 58614 32958 49577 85822 59747 89949 97152 54666 53212 58067 33110 59983 75463 56401 78975 94976 53757 53250 57454 33021 40278 80245 64773 73253 92623 52516 53768 56975 33181 33392 77079 68026 74037 90840 52057 53869 56148 33264 31009 61815 84288 76990 91044 51688 54773 55889 33239 46860 54153 84174 83195 94331 53106 56384 55975 33471 36298 63818 78618 87766 93923 52466 56926 55345 33525 33765 65730 61185 96059 91718 51795 57312 54606 33562 30808 56908 63612 98893 90124 51068 57378 54045 33516 31481 53264 62673 96403 89408 50413 56852 53579 33603 38165 51470 64549 93436 88884 50051 56897 53454 33549 63960 63334 61103 100409 94542 51953 57484 55154 33805 50949 91894 61047 98369 96969 53147 57615 55012 33712 58751 81410 61589 86173 97164 52773 57792 54362 33761 46894 81247 71233 80295 95079 51670 57262 53916 33881
Names of X columns:
-1m 1m-3m 3m-6m 6m-1j 1j-2j 2j-3j 3j-5j 5j-10j 10j+

Sample Range: (leave blank to include all observations)
From:
To:

Column Number of Endogenous Series (?)


Fixed Seasonal Effects


Type of Equation


Degree of Predetermination (lagged endogenous variables)


Degree of Seasonal Predetermination


Seasonality


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') }

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