## 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 14:32:43 -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/t1352143999pbujjehspgv7xbd.htm/, Retrieved Sat, 23 Sep 2023 11:06:51 +0000
Statistical Computations at FreeStatistics.org, Office for Research Development and Education, URL https://freestatistics.org/blog/index.php?pk=186254, Retrieved Sat, 23 Sep 2023 11:06:51 +0000
QR Codes:

Original text written by user:
IsPrivate?No (this computation is public)
User-defined keywords
Estimated Impact127
Family? (F = Feedback message, R = changed R code, M = changed R Module, P = changed Parameters, D = changed Data)
-     [Multiple Regression] [] [2010-11-17 09:14:55] [b98453cac15ba1066b407e146608df68]
-   PD  [Multiple Regression] [maandeffect t] [2012-11-05 19:19:42] [2c4ddb4bf62114b8025bb962e2c7a2b5]
- R         [Multiple Regression] [maandeffect?] [2012-11-05 19:32:43] [b4b733de199089e913cc2b6ea19b06b9] [Current]
Feedback Forum

Post a new message
Dataseries X:
1	-19	-3	53	14	24	20	-9	-2	20	6	-29	17
2	-20	-4	50	16	24	19	-12	-4	21	6	-29	13
3	-21	-7	50	19	31	21	-10	-5	20	5	-27	12
4	-19	-7	51	18	25	17	-10	-2	21	5	-29	13
5	-17	-7	53	19	28	15	-11	-4	19	3	-24	10
6	-16	-3	49	20	24	18	-11	-4	22	5	-29	14
7	-10	0	54	20	25	19	-10	-5	20	5	-21	13
8	-16	-5	57	24	16	16	-13	-7	18	5	-20	10
9	-10	-3	58	18	17	21	-10	-5	16	3	-26	11
10	-8	3	56	15	11	26	-6	-6	17	6	-19	12
11	-7	2	60	25	12	23	-9	-4	18	6	-22	7
12	-15	-7	55	23	39	24	-8	-2	19	4	-22	11
13	-7	-1	54	20	19	23	-12	-3	18	6	-15	9
14	-6	0	52	20	14	19	-10	0	20	5	-16	13
15	-6	-3	55	22	15	25	-11	-4	21	4	-22	12
16	2	4	56	25	7	21	-13	-3	18	5	-21	5
17	-4	2	54	22	12	19	-10	-3	19	5	-11	13
18	-4	3	53	26	12	20	-10	-3	19	4	-10	11
19	-8	0	59	27	14	20	-11	-4	19	3	-6	8
20	-10	-10	62	41	9	17	-11	-5	21	2	-8	8
21	-16	-10	63	29	8	25	-11	-5	19	3	-15	8
22	-14	-9	64	33	4	19	-10	-6	19	2	-16	8
23	-30	-22	75	39	7	13	-13	-10	17	-1	-24	0
24	-33	-16	77	27	3	15	-12	-11	16	0	-27	3
25	-40	-18	79	27	5	15	-13	-13	16	-2	-33	0
26	-38	-14	77	25	0	13	-15	-12	17	1	-29	-1
27	-39	-12	82	19	-2	11	-16	-13	16	-2	-34	-1
28	-46	-17	83	15	6	9	-18	-12	15	-2	-37	-4
29	-50	-23	81	19	11	2	-17	-15	16	-2	-31	1
30	-55	-28	78	23	9	-2	-18	-14	16	-6	-33	-1
31	-66	-31	79	23	17	-4	-20	-16	16	-4	-25	0
32	-63	-21	79	7	21	-2	-22	-16	18	-2	-27	-1
33	-56	-19	73	1	21	1	-17	-12	19	0	-21	6
34	-66	-22	72	7	41	-13	-19	-16	16	-5	-32	0
35	-63	-22	67	4	57	-11	-18	-15	16	-4	-31	-3
36	-69	-25	67	-8	65	-14	-26	-17	16	-5	-32	-3
37	-69	-16	50	-14	68	-4	-19	-15	18	-1	-30	4
38	-72	-22	45	-10	73	-9	-23	-14	16	-2	-34	1
39	-69	-21	39	-11	71	-5	-21	-15	15	-4	-35	0
40	-67	-10	39	-10	71	-4	-27	-14	15	-1	-37	-4
41	-64	-7	37	-8	70	-8	-27	-16	16	1	-32	-2
42	-61	-5	30	-8	69	-1	-21	-11	18	1	-28	3
43	-58	-4	24	-7	65	-2	-22	-14	16	-2	-26	2
44	-47	7	27	-8	57	-1	-24	-12	19	1	-24	5
45	-44	6	19	-4	57	8	-21	-11	19	1	-27	6
46	-42	3	19	3	57	8	-21	-13	18	3	-26	6
47	-34	10	25	-5	55	6	-22	-12	17	3	-27	3
48	-38	0	16	-4	65	7	-25	-12	19	1	-27	4
49	-41	-2	20	5	65	2	-21	-10	22	1	-24	7
50	-38	-1	25	3	64	3	-26	-12	19	0	-28	5
51	-37	2	34	6	60	0	-27	-11	19	2	-23	6
52	-22	8	39	10	43	5	-22	-10	16	2	-23	1
53	-37	-6	40	16	47	-1	-22	-12	18	-1	-29	3
54	-36	-4	38	11	40	3	-20	-12	20	1	-25	6
55	-25	4	42	10	31	4	-21	-11	17	0	-24	0
56	-15	7	46	21	27	8	-16	-12	17	1	-20	3
57	-17	3	48	18	24	10	-17	-9	17	1	-22	4
58	-19	3	51	20	23	14	-19	-6	20	3	-24	7
59	-12	8	55	18	17	15	-20	-7	21	2	-27	6
60	-17	3	52	23	16	9	-20	-7	19	0	-25	6
61	-21	-3	55	28	15	8	-20	-10	18	0	-26	6
62	-10	4	58	31	8	10	-19	-8	20	3	-24	6
63	-19	-5	72	38	5	5	-20	-11	17	-2	-26	2
64	-14	-1	70	27	6	4	-25	-12	15	0	-22	2
65	-8	5	70	21	5	8	-25	-11	17	1	-20	2
66	-16	0	63	31	12	8	-22	-11	18	-1	-26	3
67	-14	-6	66	31	8	10	-19	-9	20	-2	-22	-1
68	-30	-13	65	29	17	8	-20	-9	19	-1	-29	-4
69	-33	-15	55	24	22	10	-18	-12	20	-1	-30	4
70	-37	-8	57	27	24	-8	-17	-10	22	1	-26	5
71	-47	-20	60	36	36	-6	-17	-10	20	-2	-30	3
72	-48	-10	63	35	31	-10	-21	-13	21	-5	-33	-1
73	-50	-22	65	44	34	-15	-17	-13	19	-5	-33	-4
74	-56	-25	61	39	47	-21	-22	-12	22	-6	-31	0
75	-47	-10	65	26	33	-24	-24	-14	19	-4	-36	-1
76	-37	-8	63	27	35	-15	-18	-9	21	-3	-43	-1
77	-35	-9	59	17	31	-12	-20	-12	19	-3	-40	3
78	-29	-5	56	20	35	-11	-21	-10	21	-1	-38	2
79	-28	-7	54	22	39	-11	-17	-13	18	-2	-41	-4
80	-29	-11	56	32	46	-13	-17	-11	18	-3	-38	-3
81	-33	-11	54	28	40	-10	-17	-11	20	-3	-40	-1
82	-41	-16	58	30	50	-9	-21	-11	19	-3	-41	3


 Summary of computational transaction Raw Input view raw input (R code) Raw Output view raw output of R engine Computing time 2 seconds R Server 'Sir Maurice George Kendall' @ kendall.wessa.net

\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 & 2 seconds \tabularnewline
R Server & 'Sir Maurice George Kendall' @ kendall.wessa.net \tabularnewline
\hline
\end{tabular}
%Source: https://freestatistics.org/blog/index.php?pk=186254&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]2 seconds[/C][/ROW]
[ROW][C]R Server[/C][C]'Sir Maurice George Kendall' @ kendall.wessa.net[/C][/ROW]
[/TABLE]
Source: https://freestatistics.org/blog/index.php?pk=186254&T=0

Globally Unique Identifier (entire table): ba.freestatistics.org/blog/index.php?pk=186254&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 2 seconds R Server 'Sir Maurice George Kendall' @ kendall.wessa.net

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