Send output to:
Browser Blue - Charts White
Browser Black/White
CSV
Data X:
African elephant 6654.000 5712.000 -999.0 -999.0 3.3 38.6 645.0 3 5 3 African giant pouched rat 1.000 6.600 6.3 2.0 8.3 4.5 42.0 3 1 3 Arctic Fox 3.385 44.500 -999.0 -999.0 12.5 14.0 60.0 1 1 1 Arctic ground squirrel .920 5.700 -999.0 -999.0 16.5 -999.0 25.0 5 2 3 Asian elephant 2547.000 4603.000 2.1 1.8 3.9 69.0 624.0 3 5 4 Baboon 10.550 179.500 9.1 .7 9.8 27.0 180.0 4 4 4 Big brown bat .023 .300 15.8 3.9 19.7 19.0 35.0 1 1 1 Brazilian tapir 160.000 169.000 5.2 1.0 6.2 30.4 392.0 4 5 4 Cat 3.300 25.600 10.9 3.6 14.5 28.0 63.0 1 2 1 Chimpanzee 52.160 440.000 8.3 1.4 9.7 50.0 230.0 1 1 1 Chinchilla .425 6.400 11.0 1.5 12.5 7.0 112.0 5 4 4 Cow 465.000 423.000 3.2 .7 3.9 30.0 281.0 5 5 5 Desert hedgehog .550 2.400 7.6 2.7 10.3 -999.0 -999.0 2 1 2 Donkey 187.100 419.000 -999.0 -999.0 3.1 40.0 365.0 5 5 5 Eastern American mole .075 1.200 6.3 2.1 8.4 3.5 42.0 1 1 1 Echidna 3.000 25.000 8.6 .0 8.6 50.0 28.0 2 2 2 European hedgehog .785 3.500 6.6 4.1 10.7 6.0 42.0 2 2 2 Galago .200 5.000 9.5 1.2 10.7 10.4 120.0 2 2 2 Genet 1.410 17.500 4.8 1.3 6.1 34.0 -999.0 1 2 1 Giant armadillo 60.000 81.000 12.0 6.1 18.1 7.0 -999.0 1 1 1 Giraffe 529.000 680.000 -999.0 .3 -999.0 28.0 400.0 5 5 5 Goat 27.660 115.000 3.3 .5 3.8 20.0 148.0 5 5 5 Golden hamster .120 1.000 11.0 3.4 14.4 3.9 16.0 3 1 2 Gorilla 207.000 406.000 -999.0 -999.0 12.0 39.3 252.0 1 4 1 Gray seal 85.000 325.000 4.7 1.5 6.2 41.0 310.0 1 3 1 Gray wolf 36.330 119.500 -999.0 -999.0 13.0 16.2 63.0 1 1 1 Ground squirrel .101 4.000 10.4 3.4 13.8 9.0 28.0 5 1 3 Guinea pig 1.040 5.500 7.4 .8 8.2 7.6 68.0 5 3 4 Horse 521.000 655.000 2.1 .8 2.9 46.0 336.0 5 5 5 Jaguar 100.000 157.000 -999.0 -999.0 10.8 22.4 100.0 1 1 1 Kangaroo 35.000 56.000 -999.0 -999.0 -999.0 16.3 33.0 3 5 4 Lesser short-tailed shrew .005 .140 7.7 1.4 9.1 2.6 21.5 5 2 4 Little brown bat .010 .250 17.9 2.0 19.9 24.0 50.0 1 1 1 Man 62.000 1320.000 6.1 1.9 8.0 100.0 267.0 1 1 1 Mole rat .122 3.000 8.2 2.4 10.6 -999.0 30.0 2 1 1 Mountain beaver 1.350 8.100 8.4 2.8 11.2 -999.0 45.0 3 1 3 Mouse .023 .400 11.9 1.3 13.2 3.2 19.0 4 1 3 Musk shrew .048 .330 10.8 2.0 12.8 2.0 30.0 4 1 3 N. American opossum 1.700 6.300 13.8 5.6 19.4 5.0 12.0 2 1 1 Nine-banded armadillo 3.500 10.800 14.3 3.1 17.4 6.5 120.0 2 1 1 Okapi 250.000 490.000 -999.0 1.0 -999.0 23.6 440.0 5 5 5 Owl monkey .480 15.500 15.2 1.8 17.0 12.0 140.0 2 2 2 Patas monkey 10.000 115.000 10.0 .9 10.9 20.2 170.0 4 4 4 Phanlanger 1.620 11.400 11.9 1.8 13.7 13.0 17.0 2 1 2 Pig 192.000 180.000 6.5 1.9 8.4 27.0 115.0 4 4 4 Rabbit 2.500 12.100 7.5 .9 8.4 18.0 31.0 5 5 5 Raccoon 4.288 39.200 -999.0 -999.0 12.5 13.7 63.0 2 2 2 Rat .280 1.900 10.6 2.6 13.2 4.7 21.0 3 1 3 Red fox 4.235 50.400 7.4 2.4 9.8 9.8 52.0 1 1 1 Rhesus monkey 6.800 179.000 8.4 1.2 9.6 29.0 164.0 2 3 2 Rock hyrax (Hetero. b) .750 12.300 5.7 .9 6.6 7.0 225.0 2 2 2 Rock hyrax (Procavia hab) 3.600 21.000 4.9 .5 5.4 6.0 225.0 3 2 3 Roe deer 14.830 98.200 -999.0 -999.0 2.6 17.0 150.0 5 5 5 Sheep 55.500 175.000 3.2 .6 3.8 20.0 151.0 5 5 5 Slow loris 1.400 12.500 -999.0 -999.0 11.0 12.7 90.0 2 2 2 Star nosed mole .060 1.000 8.1 2.2 10.3 3.5 -999.0 3 1 2 Tenrec .900 2.600 11.0 2.3 13.3 4.5 60.0 2 1 2 Tree hyrax 2.000 12.300 4.9 .5 5.4 7.5 200.0 3 1 3 Tree shrew .104 2.500 13.2 2.6 15.8 2.3 46.0 3 2 2 Vervet 4.190 58.000 9.7 .6 10.3 24.0 210.0 4 3 4 Water opossum 3.500 3.900 12.8 6.6 19.4 3.0 14.0 2 1 1 Yellow-bellied marmot 4.050 17.000 -999.0 -999.0 -999.0 13.0 38.0 3 1 1
Names of X columns:
Cons Inc Price
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