## Free Statistics

of Irreproducible Research!

Author's title
Author*The author of this computation has been verified*
R Software Modulerwasp_multipleregression.wasp
Title produced by softwareMultiple Regression
Date of computationMon, 05 Nov 2012 15:57:13 -0500
Cite this page as followsStatistical Computations at FreeStatistics.org, Office for Research Development and Education, URL https://freestatistics.org/blog/index.php?v=date/2012/Nov/05/t1352149061hbiqfvqg2635vqw.htm/, Retrieved Tue, 21 Mar 2023 06:52:47 +0000
Statistical Computations at FreeStatistics.org, Office for Research Development and Education, URL https://freestatistics.org/blog/index.php?pk=186294, Retrieved Tue, 21 Mar 2023 06:52:47 +0000
QR Codes:

Original text written by user:
IsPrivate?No (this computation is public)
User-defined keywords
Estimated Impact99
Family? (F = Feedback message, R = changed R code, M = changed R Module, P = changed Parameters, D = changed Data)
-       [Multiple Regression] [mini-tutorial ws 7] [2012-11-05 20:57:13] [8c1e1aad2e0aebe6ad8d0bf075616208] [Current]
Feedback Forum

Post a new message
Dataseries X:
1911	17	 56	 51
2598	19	 73	 48
2145	18	 62	 46
1331	15	 42	 42
7349	12	 27	 39
1432	15	 59	 38
1215	20	 78	 36
1547	14	 56	 36
1134	15	 59	 36
1552	12	 47	 35
2108	13	 51	 34
1348	17	 47	 34
1534	15	 55	 32
1513	13	 47	 32
1628	15	 54	 31
843	10	 35	 31
1540	13	 47	 31
1075	12	 48	 31
1600	12	 42	 30
1233	16	 55	 30
945	15	 60	 30
1371	13	 51	 28
1758	12	 38	 27
1318	12	 47	 27
1313	15	 52	 27
1115	12	 12	 26
1254	12	 48	 26
1071	13	 46	 26
1487	       8	 32	 26
1098	     9	 27	 26
1325	12	 47	 26
1542	13	 42	 26
1275	12	 48	 26
1180	12	 47	 26
930	15	 60	 25
1216	12	 42	 25
863	12	 46	 25
903	16	 58	 25
1365	12	 41	 25
843	15	 56	 25
1290	14	 47	 25
1508	12	 48	 25
1470	12	 48	 24
826	12	 41	 24
923	12	 39	 24
1064	15	 60	 24
1402	12	 45	 24
1218	13	 49	 23
979	 9	 32	 23
1203	12	 41	 23
1491	13	 39	 23
983	13	 50	 23
708	15	 49	 23
1016	 9	 36	 23
874	15	 52	 23
853	12	 39	 23
1107	13	 55	 22
1132	13	 45	 22
1231	14	 52	 22
1671	13	 48	 22
1206	14	 41	 21
804	15	 45	 21
775	12	 48	 21
614	14	 52	 20
988	12	 22	 20
1233	15	 51	 20
1169	12	 47	 19
1209	16	 54	 19
706	13	 52	 18
932	12	 45	 18
874	12	 41	 18
934	 9	 27	 18
619	12	 43	 18
679	10	 40	 17
828	16	 57	 17
760	13	  9	 17
844	12	 24	 16
1061	15	 30	 16
779	12	 41	 16
918	10	 31	 16
792	12	 46	 16
847	14	 44	 15
563	 8	 21	 15
548	15	 32	 15
835	12	 33	 15
861	12	 32	 15
504	13	 46	 15
575	12	 45	 15
487	12	 37	 15
641	16	 64	 15
681	13	 35	 14
872	12	 21	 14
715	12	 20	 14
997	13	 26	 14
564	 8	 21	 14
959	12	 36	 13
476	 8	 19	 13
563	 8	 31	 13
646	16	 20	 13
960	11	 33	 13
500	15	 58	 13
637	12	 13	 13
567	13	 34	 12
781	12	 15	 12
428	11	 24	 12
694	13	 32	 12
620	 4	 15	 12
831	12	 40	 12
569	16	 47	 11
614	12	 31	 11
573	12	 37	 11
583	14	 26	 11
488	 5	  9	 10
508	 9	 28	 10
533	13	 18	 10
630	10	 32	  9
387	13	 35	  9
511	12	 29	  9
585	13	  1	  9
581	12	 20	  9
475	13	 45	  9
413	12	 11	  8
495	12	 33	  8
427	12	 41	  7
350	 5	 10	  7
335	 6	  0	  6
349	 9	 10	  6
470	15	 28	  5
229	11	 38	  5
308	12	 24	  5
250	 9	 31	  5
242	 8	 25	  5
244	 0	  0	  5
431	 3	  4	  5
352	12	 40	  5
285	 9	 23	  5
242	 4	 13	  4
291	14	  6	  4
136	 0	  0	  3
211	 1	  3	  3
268	 6	  7	  2
231	 0	  0	  2
44	 0	  0	  2
340	 0	  0	  2
126	 6	  2	  2
25	 0	  0	  1
143	 2	  5	  1
104	 0	  0	  1
11	 0	  0	  0		

 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 'Sir Ronald Aylmer Fisher' @ fisher.wessa.net R Framework error message Warning: there are blank lines in the 'Data X' field. Please, use NA for missing data - blank lines are simply deleted and are NOT treated as missing values. R Engine error message Error in list(1911, 17, 56, 51, 2598, 19, 73, 48, 2145, 18, 62, 46, 1331, : argument 597 is empty Calls: array Execution halted 

\begin{tabular}{lllllllll}
\hline
Summary of computational transaction \tabularnewline
Raw Input & view raw input (R code)  \tabularnewline
Raw Output & view raw output of R engine  \tabularnewline
Computing time & 1 seconds \tabularnewline
R Server & 'Sir Ronald Aylmer Fisher' @ fisher.wessa.net \tabularnewline
R Framework error message & Warning: there are blank lines in the 'Data X' field.
Please, use NA for missing data - blank lines are simply
deleted and are NOT treated as missing values. \tabularnewline
R Engine error message & Error in list(1911, 17, 56, 51, 2598, 19, 73, 48, 2145, 18, 62, 46, 1331,  :
argument 597 is empty
Calls: array
Execution halted
\tabularnewline
\hline
\end{tabular}
%Source: https://freestatistics.org/blog/index.php?pk=186294&T=0

[TABLE]
[ROW][C]Summary of computational transaction[/C][/ROW]
[ROW][C]Raw Input[/C][C]view raw input (R code) [/C][/ROW]
[ROW][C]Raw Output[/C][C]view raw output of R engine [/C][/ROW]
[ROW][C]Computing time[/C][C]1 seconds[/C][/ROW]
[ROW][C]R Server[/C][C]'Sir Ronald Aylmer Fisher' @ fisher.wessa.net[/C][/ROW]
[ROW][C]R Framework error message[/C][C]Warning: there are blank lines in the 'Data X' field.
Please, use NA for missing data - blank lines are simply
deleted and are NOT treated as missing values.[/C][/ROW]
[ROW][C]R Engine error message[/C][C]Error in list(1911, 17, 56, 51, 2598, 19, 73, 48, 2145, 18, 62, 46, 1331,  :
argument 597 is empty
Calls: array
Execution halted
[/C][/ROW]
[/TABLE]
Source: https://freestatistics.org/blog/index.php?pk=186294&T=0

Globally Unique Identifier (entire table): ba.freestatistics.org/blog/index.php?pk=186294&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 1 seconds R Server 'Sir Ronald Aylmer Fisher' @ fisher.wessa.net R Framework error message Warning: there are blank lines in the 'Data X' field. Please, use NA for missing data - blank lines are simply deleted and are NOT treated as missing values. R Engine error message Error in list(1911, 17, 56, 51, 2598, 19, 73, 48, 2145, 18, 62, 46, 1331, : argument 597 is empty Calls: array Execution halted 

Parameters (Session):
par1 = 4 ; par2 = Do not include Seasonal Dummies ; par3 = No Linear Trend ;
Parameters (R input):
par1 = 4 ; par2 = Do not include Seasonal Dummies ; par3 = No Linear Trend ;
R code (references can be found in the software module):
library(lattice)library(lmtest)n25 <- 25 #minimum number of obs. for Goldfeld-Quandt testpar1 <- 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 <- x1if (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'}xk <- length(x[1,])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')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)dumdum1 <- dum[2:length(myerror),]dum1z <- as.data.frame(dum1)zplot(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('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-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,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, '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,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')}