Send output to:
Browser Blue - Charts White
Browser Black/White
CSV
Data X:
74.2 112.7 NA NA NA NA 91.7 122 112.7 NA NA NA 100.7 134.7 122 112.7 NA NA 82.7 109.8 134.7 122 112.7 NA 95.1 130.8 109.8 134.7 122 112.7 93.3 118.7 130.8 109.8 134.7 122 57.5 104.4 118.7 130.8 109.8 134.7 76.7 87.8 104.4 118.7 130.8 109.8 99.2 134.2 87.8 104.4 118.7 130.8 101.5 143.9 134.2 87.8 104.4 118.7 96.1 140.4 143.9 134.2 87.8 104.4 85.9 111 140.4 143.9 134.2 87.8 84.4 126.3 111 140.4 143.9 134.2 90.8 124.4 126.3 111 140.4 143.9 101.9 136.1 124.4 126.3 111 140.4 88.7 118.4 136.1 124.4 126.3 111 94 127.4 118.4 136.1 124.4 126.3 101.2 127.9 127.4 118.4 136.1 124.4 61.2 115 127.9 127.4 118.4 136.1 80.1 90.2 115 127.9 127.4 118.4 98.3 131 90.2 115 127.9 127.4 100.6 143.3 131 90.2 115 127.9 90.6 131.5 143.3 131 90.2 115 83.1 98.5 131.5 143.3 131 90.2 82.4 124.9 98.5 131.5 143.3 131 87.8 122.4 124.9 98.5 131.5 143.3 94.1 128.8 122.4 124.9 98.5 131.5 89.8 125.9 128.8 122.4 124.9 98.5 84.9 120.2 125.9 128.8 122.4 124.9 91.7 120 120.2 125.9 128.8 122.4 63.2 116 120 120.2 125.9 128.8 70.4 89.2 116 120 120.2 125.9 97 135.9 89.2 116 120 120.2 98.5 148.7 135.9 89.2 116 120 79.2 128.1 148.7 135.9 89.2 116 78.7 100.9 128.1 148.7 135.9 89.2 78.7 125.5 100.9 128.1 148.7 135.9 85.7 119.8 125.5 100.9 128.1 148.7 86.4 120.7 119.8 125.5 100.9 128.1 82.7 125 120.7 119.8 125.5 100.9 76.1 109 125 120.7 119.8 125.5 89.7 114.2 109 125 120.7 119.8 64.4 105.6 114.2 109 125 120.7 67.9 80.1 105.6 114.2 109 125 93.1 131.1 80.1 105.6 114.2 109 95.7 136.6 131.1 80.1 105.6 114.2 81.3 119.7 136.6 131.1 80.1 105.6 78.6 102.4 119.7 136.6 131.1 80.1 76.1 114.5 102.4 119.7 136.6 131.1 85.8 112.9 114.5 102.4 119.7 136.6 101.5 131.8 112.9 114.5 102.4 119.7 88.5 118.7 131.8 112.9 114.5 102.4 75.8 107.1 118.7 131.8 112.9 114.5 99.1 127 107.1 118.7 131.8 112.9 57.8 104.6 127 107.1 118.7 131.8 75.8 85.9 104.6 127 107.1 118.7 98.8 134 85.9 104.6 127 107.1 93 127.6 134 85.9 104.6 127 93.4 121.5 127.6 134 85.9 104.6 88.2 104.5 121.5 127.6 134 85.9 80.3 107.3 104.5 121.5 127.6 134 92.3 111.9 107.3 104.5 121.5 127.6 98.5 120.7 111.9 107.3 104.5 121.5 92.9 116.9 120.7 111.9 107.3 104.5 85.8 106.1 116.9 120.7 111.9 107.3 100.7 122.3 106.1 116.9 120.7 111.9 60.9 97.8 122.3 106.1 116.9 120.7 80.1 82.7 97.8 122.3 106.1 116.9 106.8 128.2 82.7 97.8 122.3 106.1 93.7 119 128.2 82.7 97.8 122.3 98.2 127.4 119 128.2 82.7 97.8 91.7 106 127.4 119 128.2 82.7 86.9 108.7 106 127.4 119 128.2 93.3 113.5 108.7 106 127.4 119 106.2 131.4 113.5 108.7 106 127.4 86.5 111.3 131.4 113.5 108.7 106 91.8 119 111.3 131.4 113.5 108.7 107.8 130.7 119 111.3 131.4 113.5 60.4 104.5 130.7 119 111.3 131.4 84 88.9 104.5 130.7 119 111.3 108.3 135.4 88.9 104.5 130.7 119 105.6 140.6 135.4 88.9 104.5 130.7 102 138.8 140.6 135.4 88.9 104.5 93.7 107.4 138.8 140.6 135.4 88.9 91.5 120.8 107.4 138.8 140.6 135.4 101.6 124.1 120.8 107.4 138.8 140.6 109.9 139.2 124.1 120.8 107.4 138.8 96.8 119.9 139.2 124.1 120.8 107.4 100.3 121 119.9 139.2 124.1 120.8 116.3 133.7 121 119.9 139.2 124.1 71.3 115.2 133.7 121 119.9 139.2 96.8 96.7 115.2 133.7 121 119.9 112.9 131 96.7 115.2 133.7 121 117.8 147.6 131 96.7 115.2 133.7 104.4 132.9 147.6 131 96.7 115.2 95.4 97.4 132.9 147.6 131 96.7 92.2 123.6 97.4 132.9 147.6 131 103.3 124.9 123.6 97.4 132.9 147.6 103.4 118.6 124.9 123.6 97.4 132.9 112 127.6 118.6 124.9 123.6 97.4 102.2 110.2 127.6 118.6 124.9 123.6 114.9 115.4 110.2 127.6 118.6 124.9 80.2 106.6 115.4 110.2 127.6 118.6 81.4 75.5 106.6 115.4 110.2 127.6 122.1 116.7 75.5 106.6 115.4 110.2 121.6 118 116.7 75.5 106.6 115.4 98.4 98.7 118 116.7 75.5 106.6 98.2 81.5 98.7 118 116.7 75.5 90.2 87 81.5 98.7 118 116.7 100.8 86.8 87 81.5 98.7 118 108.8 96.8 86.8 87 81.5 98.7 95.9 92.7 96.8 86.8 87 81.5 87.7 82.1 92.7 96.8 86.8 87 103.9 94.1 82.1 92.7 96.8 86.8 73.2 89.7 94.1 82.1 92.7 96.8 86.6 67.5 89.7 94.1 82.1 92.7 116.1 102 67.5 89.7 94.1 82.1 111.4 103.2 102 67.5 89.7 94.1 99.5 95.6 103.2 102 67.5 89.7 96.5 83 95.6 103.2 102 67.5 90.7 87.2 83 95.6 103.2 102 98.9 94 87.2 83 95.6 103.2 112 107.7 94 87.2 83 95.6 100.4 103.3 107.7 94 87.2 83 94.4 94.8 103.3 107.7 94 87.2 111.2 112.7 94.8 103.3 107.7 94 71 96.8 112.7 94.8 103.3 107.7 86.8 75.9 96.8 112.7 94.8 103.3 119.5 116.7 75.9 96.8 112.7 94.8 106.3 111.4 116.7 75.9 96.8 112.7 101.5 108.6 111.4 116.7 75.9 96.8 107.3 90.9 108.6 111.4 116.7 75.9 89.2 92.6 90.9 108.6 111.4 116.7 102.6 95.7 92.6 90.9 108.6 111.4 112.3 116.7 95.7 92.6 90.9 108.6 94.3 95.4 116.7 95.7 92.6 90.9 102.2 105.1 95.4 116.7 95.7 92.6 103.4 99.7 105.1 95.4 116.7 95.7 72.2 89.8 99.7 105.1 95.4 116.7 95.9 74 89.8 99.7 105.1 95.4 118.8 108 74 89.8 99.7 105.1 105.1 102.1 108 74 89.8 99.7 97.2 100.2 102.1 108 74 89.8 101.9 83.2 100.2 102.1 108 74 93.4 87.9 83.2 100.2 102.1 108 108.4 93.3 87.9 83.2 100.2 102.1 110.7 98.5 93.3 87.9 83.2 100.2 90.8 84.5 98.5 93.3 87.9 83.2 99.6 89.3 84.5 98.5 93.3 87.9 111.6 94.2 89.3 84.5 98.5 93.3 72.4 83.5 94.2 89.3 84.5 98.5 88.1 67.5 83.5 94.2 89.3 84.5 111.6 89.4 67.5 83.5 94.2 89.3 101.6 102.4 89.4 67.5 83.5 94.2 95.2 92 102.4 89.4 67.5 83.5 83.8 65.9 92 102.4 89.4 67.5 80.2 85.3 65.9 92 102.4 89.4 88.2 87 85.3 65.9 92 102.4 92.6 91.8 87 85.3 65.9 92 87.7 88.5 91.8 87 85.3 65.9 91.8 89.1 88.5 91.8 87 85.3 94.2 89.8 89.1 88.5 91.8 87 68.8 88.9 89.8 89.1 88.5 91.8 73.7 64 88.9 89.8 89.1 88.5 99.3 93.2 64 88.9 89.8 89.1 96.8 100.1 93.2 64 88.9 89.8 89.1 89.3 100.1 93.2 64 88.9 87.9 68.1 89.3 100.1 93.2 64 82.8 94.3 68.1 89.3 100.1 93.2 92.6 93.3 94.3 68.1 89.3 100.1 94.7 98.1 93.3 94.3 68.1 89.3 87.8 96.8 98.1 93.3 94.3 68.1 83.3 87.8 96.8 98.1 93.3 94.3 90.3 95.6 87.8 96.8 98.1 93.3 70.6 95.7 95.6 87.8 96.8 98.1 69.9 64.4 95.7 95.6 87.8 96.8 95.6 108.1 64.4 95.7 95.6 87.8 102.3 109.6 108.1 64.4 95.7 95.6 81.1 90.9 109.6 108.1 64.4 95.7 84.2 75.6 90.9 109.6 108.1 64.4 83.8 93.5 75.6 90.9 109.6 108.1 87.6 98.1 93.5 75.6 90.9 109.6 98.8 104.5 98.1 93.5 75.6 90.9 90 102.7 104.5 98.1 93.5 75.6 80.3 89.6 102.7 104.5 98.1 93.5 104 108.8 89.6 102.7 104.5 98.1 70.5 95.4 108.8 89.6 102.7 104.5 73.2 70.1 95.4 108.8 89.6 102.7 105.9 104.6 70.1 95.4 108.8 89.6 100.1 105.5 104.6 70.1 95.4 108.8 87.5 96.8 105.5 104.6 70.1 95.4 86 79.4 96.8 105.5 104.6 70.1 79 92.3 79.4 96.8 105.5 104.6 94.4 96.8 92.3 79.4 96.8 105.5 98.6 103 96.8 92.3 79.4 96.8 90.2 99.5 103 96.8 92.3 79.4 89.7 91 99.5 103 96.8 92.3 105.7 103.4 91 99.5 103 96.8 66.9 82 103.4 91 99.5 103 79.5 70.1 82 103.4 91 99.5 100.2 98.1 70.1 82 103.4 91 94.6 95.7 98.1 70.1 82 103.4 92.1 98 95.7 98.1 70.1 82 90.4 77.3 98 95.7 98.1 70.1 81 89.8 77.3 98 95.7 98.1 89.4 91.6 89.8 77.3 98 95.7 103.5 106.5 91.6 89.8 77.3 98 79.8 87.5 106.5 91.6 89.8 77.3 89 99.5 87.5 106.5 91.6 89.8 100 104.4 99.5 87.5 106.5 91.6 68 84.5 104.4 99.5 87.5 106.5 73.7 68.3 84.5 104.4 99.5 87.5
Names of X columns:
Funtiture Textiles0 Textiles1 Textiles2 Textiles3 Textiles4
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
12
1
2
3
4
5
6
7
8
9
10
11
12
Chart options
R Code
library(lattice) library(lmtest) library(car) library(MASS) n25 <- 25 #minimum number of obs. for Goldfeld-Quandt test mywarning <- '' par6 <- as.numeric(par6) if(is.na(par6)) { par6 <- 12 mywarning = 'Warning: you did not specify the seasonality. The seasonal period was set to s = 12.' } par1 <- as.numeric(par1) if(is.na(par1)) { par1 <- 1 mywarning = 'Warning: you did not specify the column number of the endogenous series! The first column was selected by default.' } if (par4=='') par4 <- 0 par4 <- as.numeric(par4) if (!is.numeric(par4)) par4 <- 0 if (par5=='') par5 <- 0 par5 <- as.numeric(par5) if (!is.numeric(par5)) par5 <- 0 x <- na.omit(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'){ (n <- n -1) x2 <- array(0, dim=c(n,k), dimnames=list(1:n, paste('(1-B)',colnames(x),sep=''))) for (i in 1:n) { for (j in 1:k) { x2[i,j] <- x[i+1,j] - x[i,j] } } x <- x2 } if (par3 == 'Seasonal Differences (s)'){ (n <- n - par6) x2 <- array(0, dim=c(n,k), dimnames=list(1:n, paste('(1-Bs)',colnames(x),sep=''))) for (i in 1:n) { for (j in 1:k) { x2[i,j] <- x[i+par6,j] - x[i,j] } } x <- x2 } if (par3 == 'First and Seasonal Differences (s)'){ (n <- n -1) x2 <- array(0, dim=c(n,k), dimnames=list(1:n, paste('(1-B)',colnames(x),sep=''))) for (i in 1:n) { for (j in 1:k) { x2[i,j] <- x[i+1,j] - x[i,j] } } x <- x2 (n <- n - par6) x2 <- array(0, dim=c(n,k), dimnames=list(1:n, paste('(1-Bs)',colnames(x),sep=''))) for (i in 1:n) { for (j in 1:k) { x2[i,j] <- x[i+par6,j] - x[i,j] } } x <- x2 } if(par4 > 0) { x2 <- array(0, dim=c(n-par4,par4), dimnames=list(1:(n-par4), paste(colnames(x)[par1],'(t-',1:par4,')',sep=''))) for (i in 1:(n-par4)) { for (j in 1:par4) { x2[i,j] <- x[i+par4-j,par1] } } x <- cbind(x[(par4+1):n,], x2) n <- n - par4 } if(par5 > 0) { x2 <- array(0, dim=c(n-par5*par6,par5), dimnames=list(1:(n-par5*par6), paste(colnames(x)[par1],'(t-',1:par5,'s)',sep=''))) for (i in 1:(n-par5*par6)) { for (j in 1:par5) { x2[i,j] <- x[i+par5*par6-j*par6,par1] } } x <- cbind(x[(par5*par6+1):n,], x2) n <- n - par5*par6 } if (par2 == 'Include Seasonal Dummies'){ x2 <- array(0, dim=c(n,par6-1), dimnames=list(1:n, paste('M', seq(1:(par6-1)), sep =''))) for (i in 1:(par6-1)){ x2[seq(i,n,par6),i] <- 1 } x <- cbind(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[n,])) if (par3 == 'Linear Trend'){ x <- cbind(x, c(1:n)) colnames(x)[k+1] <- 't' } print(x) (k <- length(x[n,])) head(x) 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') sresid <- studres(mylm) hist(sresid, freq=FALSE, main='Distribution of Studentized Residuals') xfit<-seq(min(sresid),max(sresid),length=40) yfit<-dnorm(xfit) lines(xfit, yfit) 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') qqPlot(mylm, main='QQ Plot') 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) print(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, signif(mysum$coefficients[i,1],6), 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.row.start(a) a<-table.element(a, mywarning) 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,'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,formatC(signif(mysum$coefficients[i,1],5),format='g',flag='+')) a<-table.element(a,formatC(signif(mysum$coefficients[i,2],5),format='g',flag=' ')) a<-table.element(a,formatC(signif(mysum$coefficients[i,3],4),format='e',flag='+')) a<-table.element(a,formatC(signif(mysum$coefficients[i,4],4),format='g',flag=' ')) a<-table.element(a,formatC(signif(mysum$coefficients[i,4]/2,4),format='g',flag=' ')) 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,formatC(signif(sqrt(mysum$r.squared),6),format='g',flag=' ')) a<-table.row.end(a) a<-table.row.start(a) a<-table.element(a, 'R-squared',1,TRUE) a<-table.element(a,formatC(signif(mysum$r.squared,6),format='g',flag=' ')) a<-table.row.end(a) a<-table.row.start(a) a<-table.element(a, 'Adjusted R-squared',1,TRUE) a<-table.element(a,formatC(signif(mysum$adj.r.squared,6),format='g',flag=' ')) a<-table.row.end(a) a<-table.row.start(a) a<-table.element(a, 'F-TEST (value)',1,TRUE) a<-table.element(a,formatC(signif(mysum$fstatistic[1],6),format='g',flag=' ')) a<-table.row.end(a) a<-table.row.start(a) a<-table.element(a, 'F-TEST (DF numerator)',1,TRUE) a<-table.element(a, signif(mysum$fstatistic[2],6)) a<-table.row.end(a) a<-table.row.start(a) a<-table.element(a, 'F-TEST (DF denominator)',1,TRUE) a<-table.element(a, signif(mysum$fstatistic[3],6)) a<-table.row.end(a) a<-table.row.start(a) a<-table.element(a, 'p-value',1,TRUE) a<-table.element(a,formatC(signif(1-pf(mysum$fstatistic[1],mysum$fstatistic[2],mysum$fstatistic[3]),6),format='g',flag=' ')) 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,formatC(signif(mysum$sigma,6),format='g',flag=' ')) a<-table.row.end(a) a<-table.row.start(a) a<-table.element(a, 'Sum Squared Residuals',1,TRUE) a<-table.element(a,formatC(signif(sum(myerror*myerror),6),format='g',flag=' ')) a<-table.row.end(a) a<-table.end(a) table.save(a,file='mytable3.tab') myr <- as.numeric(mysum$resid) myr a <-table.start() a <- table.row.start(a) a <- table.element(a,'Menu of Residual Diagnostics',2,TRUE) a <- table.row.end(a) a <- table.row.start(a) a <- table.element(a,'Description',1,TRUE) a <- table.element(a,'Link',1,TRUE) a <- table.row.end(a) a <- table.row.start(a) a <-table.element(a,'Histogram',1,header=TRUE) a <- table.element(a,hyperlink( paste('https://supernova.wessa.net/rwasp_histogram.wasp?convertgetintopost=1&data=',paste(as.character(mysum$resid),sep='',collapse=' '),sep='') ,'Compute','Click here to examine the Residuals.'),1) a <- table.row.end(a) a <- table.row.start(a) a <-table.element(a,'Central Tendency',1,header=TRUE) a <- table.element(a,hyperlink( paste('https://supernova.wessa.net/rwasp_centraltendency.wasp?convertgetintopost=1&data=',paste(as.character(mysum$resid),sep='',collapse=' '),sep='') ,'Compute','Click here to examine the Residuals.'),1) a <- table.row.end(a) a <- table.row.start(a) a <-table.element(a,'QQ Plot',1,header=TRUE) a <- table.element(a,hyperlink( paste('https://supernova.wessa.net/rwasp_fitdistrnorm.wasp?convertgetintopost=1&data=',paste(as.character(mysum$resid),sep='',collapse=' '),sep='') ,'Compute','Click here to examine the Residuals.'),1) a <- table.row.end(a) a <- table.row.start(a) a <-table.element(a,'Kernel Density Plot',1,header=TRUE) a <- table.element(a,hyperlink( paste('https://supernova.wessa.net/rwasp_density.wasp?convertgetintopost=1&data=',paste(as.character(mysum$resid),sep='',collapse=' '),sep='') ,'Compute','Click here to examine the Residuals.'),1) a <- table.row.end(a) a <- table.row.start(a) a <-table.element(a,'Skewness/Kurtosis Test',1,header=TRUE) a <- table.element(a,hyperlink( paste('https://supernova.wessa.net/rwasp_skewness_kurtosis.wasp?convertgetintopost=1&data=',paste(as.character(mysum$resid),sep='',collapse=' '),sep='') ,'Compute','Click here to examine the Residuals.'),1) a <- table.row.end(a) a <- table.row.start(a) a <-table.element(a,'Skewness-Kurtosis Plot',1,header=TRUE) a <- table.element(a,hyperlink( paste('https://supernova.wessa.net/rwasp_skewness_kurtosis_plot.wasp?convertgetintopost=1&data=',paste(as.character(mysum$resid),sep='',collapse=' '),sep='') ,'Compute','Click here to examine the Residuals.'),1) a <- table.row.end(a) a <- table.row.start(a) a <-table.element(a,'Harrell-Davis Plot',1,header=TRUE) a <- table.element(a,hyperlink( paste('https://supernova.wessa.net/rwasp_harrell_davis.wasp?convertgetintopost=1&data=',paste(as.character(mysum$resid),sep='',collapse=' '),sep='') ,'Compute','Click here to examine the Residuals.'),1) a <- table.row.end(a) a <- table.row.start(a) a <-table.element(a,'Bootstrap Plot -- Central Tendency',1,header=TRUE) a <- table.element(a,hyperlink( paste('https://supernova.wessa.net/rwasp_bootstrapplot1.wasp?convertgetintopost=1&data=',paste(as.character(mysum$resid),sep='',collapse=' '),sep='') ,'Compute','Click here to examine the Residuals.'),1) a <- table.row.end(a) a <- table.row.start(a) a <-table.element(a,'Blocked Bootstrap Plot -- Central Tendency',1,header=TRUE) a <- table.element(a,hyperlink( paste('https://supernova.wessa.net/rwasp_bootstrapplot.wasp?convertgetintopost=1&data=',paste(as.character(mysum$resid),sep='',collapse=' '),sep='') ,'Compute','Click here to examine the Residuals.'),1) a <- table.row.end(a) a <- table.row.start(a) a <-table.element(a,'(Partial) Autocorrelation Plot',1,header=TRUE) a <- table.element(a,hyperlink( paste('https://supernova.wessa.net/rwasp_autocorrelation.wasp?convertgetintopost=1&data=',paste(as.character(mysum$resid),sep='',collapse=' '),sep='') ,'Compute','Click here to examine the Residuals.'),1) a <- table.row.end(a) a <- table.row.start(a) a <-table.element(a,'Spectral Analysis',1,header=TRUE) a <- table.element(a,hyperlink( paste('https://supernova.wessa.net/rwasp_spectrum.wasp?convertgetintopost=1&data=',paste(as.character(mysum$resid),sep='',collapse=' '),sep='') ,'Compute','Click here to examine the Residuals.'),1) a <- table.row.end(a) a <- table.row.start(a) a <-table.element(a,'Tukey lambda PPCC Plot',1,header=TRUE) a <- table.element(a,hyperlink( paste('https://supernova.wessa.net/rwasp_tukeylambda.wasp?convertgetintopost=1&data=',paste(as.character(mysum$resid),sep='',collapse=' '),sep='') ,'Compute','Click here to examine the Residuals.'),1) a <- table.row.end(a) a <- table.row.start(a) a <-table.element(a,'Box-Cox Normality Plot',1,header=TRUE) a <- table.element(a,hyperlink( paste('https://supernova.wessa.net/rwasp_boxcoxnorm.wasp?convertgetintopost=1&data=',paste(as.character(mysum$resid),sep='',collapse=' '),sep='') ,'Compute','Click here to examine the Residuals.'),1) a <- table.row.end(a) a <- table.row.start(a) a <- table.element(a,'Summary Statistics',1,header=TRUE) a <- table.element(a,hyperlink( paste('https://supernova.wessa.net/rwasp_summary1.wasp?convertgetintopost=1&data=',paste(as.character(mysum$resid),sep='',collapse=' '),sep='') ,'Compute','Click here to examine the Residuals.'),1) a <- table.row.end(a) a<-table.end(a) table.save(a,file='mytable7.tab') if(n < 200) { 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,formatC(signif(x[i],6),format='g',flag=' ')) a<-table.element(a,formatC(signif(x[i]-mysum$resid[i],6),format='g',flag=' ')) a<-table.element(a,formatC(signif(mysum$resid[i],6),format='g',flag=' ')) 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,formatC(signif(gqarr[mypoint-kp3+1,1],6),format='g',flag=' ')) a<-table.element(a,formatC(signif(gqarr[mypoint-kp3+1,2],6),format='g',flag=' ')) a<-table.element(a,formatC(signif(gqarr[mypoint-kp3+1,3],6),format='g',flag=' ')) 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,signif(numsignificant1,6)) a<-table.element(a,formatC(signif(numsignificant1/numgqtests,6),format='g',flag=' ')) 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,signif(numsignificant5,6)) a<-table.element(a,signif(numsignificant5/numgqtests,6)) 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,signif(numsignificant10,6)) a<-table.element(a,signif(numsignificant10/numgqtests,6)) 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') } } a<-table.start() a<-table.row.start(a) a<-table.element(a,'Ramsey RESET F-Test for powers (2 and 3) of fitted values',1,TRUE) a<-table.row.end(a) a<-table.row.start(a) reset_test_fitted <- resettest(mylm,power=2:3,type='fitted') a<-table.element(a,paste('<pre>',RC.texteval('reset_test_fitted'),'</pre>',sep='')) a<-table.row.end(a) a<-table.row.start(a) a<-table.element(a,'Ramsey RESET F-Test for powers (2 and 3) of regressors',1,TRUE) a<-table.row.end(a) a<-table.row.start(a) reset_test_regressors <- resettest(mylm,power=2:3,type='regressor') a<-table.element(a,paste('<pre>',RC.texteval('reset_test_regressors'),'</pre>',sep='')) a<-table.row.end(a) a<-table.row.start(a) a<-table.element(a,'Ramsey RESET F-Test for powers (2 and 3) of principal components',1,TRUE) a<-table.row.end(a) a<-table.row.start(a) reset_test_principal_components <- resettest(mylm,power=2:3,type='princomp') a<-table.element(a,paste('<pre>',RC.texteval('reset_test_principal_components'),'</pre>',sep='')) a<-table.row.end(a) a<-table.end(a) table.save(a,file='mytable8.tab') a<-table.start() a<-table.row.start(a) a<-table.element(a,'Variance Inflation Factors (Multicollinearity)',1,TRUE) a<-table.row.end(a) a<-table.row.start(a) vif <- vif(mylm) a<-table.element(a,paste('<pre>',RC.texteval('vif'),'</pre>',sep='')) a<-table.row.end(a) a<-table.end(a) table.save(a,file='mytable9.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