## Free Statistics

of Irreproducible Research!

Author's title
Author*Unverified author*
R Software Modulerwasp_multipleregression.wasp
Title produced by softwareMultiple Regression
Date of computationFri, 30 Oct 2020 16:56:53 +0100
Cite this page as followsStatistical Computations at FreeStatistics.org, Office for Research Development and Education, URL https://freestatistics.org/blog/index.php?v=date/2020/Oct/30/t16040734588weyu8mre5318p6.htm/, Retrieved Sat, 15 May 2021 23:40:17 +0000
Statistical Computations at FreeStatistics.org, Office for Research Development and Education, URL https://freestatistics.org/blog/index.php?pk=319282, Retrieved Sat, 15 May 2021 23:40:17 +0000
QR Codes:

Original text written by user:
IsPrivate?No (this computation is public)
User-defined keywords
Estimated Impact32
Family? (F = Feedback message, R = changed R code, M = changed R Module, P = changed Parameters, D = changed Data)
-       [Multiple Regression] [] [2020-10-30 15:56:53] [d41d8cd98f00b204e9800998ecf8427e] [Current]
Feedback Forum

Post a new message
Dataseries X:
2.12834%	1.70903%	2.56507%	0	0	3	2	1	3	0	4	11.050	56.925	22	18	40
16.56861%	-14.68952%	-18.14670%	0	7	0	3	9	-2	1	2	10.811	58.243	10	27	37
-0.40611%	1.48745%	7.34422%	0	0	0	0	0	0	1	4	10.259	56.815	12	15	27
2.38253%	5.89009%	11.99624%	0	0	0	0	0	0	1	2	14.724	59.655	13	16	29
-4.83873%	-28.04147%	-30.81447%	8	7	1	5	3	3	1	7	12.920	59.320	39	11	50
4.97260%	5.79887%	11.62161%	0	4	1	0	3	0	0	2	8.292	56.583	16	8	24
-1.88820%	5.18413%	13.01895%	0	0	0	0	0	1	0	11	7.871	56.629	5	57	62
2.40633%	7.27595%	13.63880%	0	0	0	0	0	0	1	1	9.152	57.242	17	16	33
-1.11385%	3.65533%	5.75965%	0	1	0	0	0	0	1	4	9.194	58.694	8	28	36
-4.47159%	1.18909%	6.70526%	2	0	2	0	0	0	0	8	7.364	57.705	35	9	44


 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

\begin{tabular}{lllllllll}
\hline
Summary of computational transaction \tabularnewline
Raw Input view raw input (R code)  \tabularnewline
Raw Outputview raw output of R engine  \tabularnewline
Computing time0 seconds \tabularnewline
R ServerBig Analytics Cloud Computing Center \tabularnewline
\hline
\end{tabular}
%Source: https://freestatistics.org/blog/index.php?pk=319282&T=0

[TABLE]
[ROW]
 Summary of computational transaction[/C][/ROW] [ROW] Raw Input[/C] view raw input (R code) [/C][/ROW] [ROW] Raw Output[/C] view raw output of R engine [/C][/ROW] [ROW] Computing time[/C] 0 seconds[/C][/ROW] [ROW] R Server[/C] Big Analytics Cloud Computing Center[/C][/ROW] [/TABLE] Source: https://freestatistics.org/blog/index.php?pk=319282&T=0

Globally Unique Identifier (entire table): ba.freestatistics.org/blog/index.php?pk=319282&T=0

As an alternative you can also use a QR Code:

The GUIDs for individual cells are displayed in the table below:

 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

Parameters (Session):
par1 = 16 ; par2 = Do not include Seasonal Dummies ; par3 = First Differences ; par4 = 0 ; par5 = 0 ; par6 = 12 ;
Parameters (R input):
par1 = 16 ; par2 = Do not include Seasonal Dummies ; par3 = First Differences ; par4 = 0 ; par5 = 0 ; par6 = 12 ;
R code (references can be found in the software module):
library(lattice)library(lmtest)library(car)library(MASS)n25 <- 25 #minimum number of obs. for Goldfeld-Quandt testmywarning <- ''par6 <- as.numeric(par6)if(is.na(par6)) {par6 <- 12mywarning = 'Warning: you did not specify the seasonality. The seasonal period was set to s = 12.'}par1 <- as.numeric(par1)if(is.na(par1)) {par1 <- 1mywarning = 'Warning: you did not specify the column number of the endogenous series! The first column was selected by default.'}if (par4=='') par4 <- 0par4 <- as.numeric(par4)if (!is.numeric(par4)) par4 <- 0if (par5=='') par5 <- 0par5 <- as.numeric(par5)if (!is.numeric(par5)) par5 <- 0x <- 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 <- x1if (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 + 3nmkm3 <- n - k - 3gqarr <- array(NA, dim=c(nmkm3-kp3+1,3))numgqtests <- 0numsignificant1 <- 0numsignificant5 <- 0numsignificant10 <- 0for (mypoint in kp3:nmkm3) {j <- 0numgqtests <- numgqtests + 1for (myalt in c('greater', 'two.sided', 'less')) {j <- j + 1gqarr[mypoint-kp3+1,j] <- gqtest(mylm, point=mypoint, alternative=myalt)$p.value}if (gqarr[mypoint-kp3+1,2] < 0.01) numsignificant1 <- numsignificant1 + 1if (gqarr[mypoint-kp3+1,2] < 0.05) numsignificant5 <- numsignificant5 + 1if (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)dumdum1 <- dum[2:length(myerror),]dum1z <- 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-STATH0: 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)myra <-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, 'InterpolationForecast', 1, TRUE)a<-table.element(a, 'ResidualsPrediction 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('',RC.texteval('reset_test_fitted'),'',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('',RC.texteval('reset_test_regressors'),'',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('',RC.texteval('reset_test_principal_components'),'',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('',RC.texteval('vif'),'',sep=''))a<-table.row.end(a)a<-table.end(a)table.save(a,file='mytable9.tab')