FreeStatistics.org

Free Statistics

of Irreproducible Research!

Description of Statistical Computation

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, 19 Nov 2012 17:58: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/19/t13533659448p6t6ojntsq1yqv.htm/, Retrieved Sun, 28 Apr 2024 05:14:41 +0000
Statistical Computations at FreeStatistics.org, Office for Research Development and Education, URL https://freestatistics.org/blog/index.php?pk=190845, Retrieved Sun, 28 Apr 2024 05:14:41 +0000
QR Codes:

Original text written by user:
IsPrivate?No (this computation is public)
User-defined keywords
Estimated Impact84

Tree of Dependent Computations

Family? (F = Feedback message, R = changed R code, M = changed R Module, P = changed Parameters, D = changed Data)
-     [Multiple Regression] [Competence to learn] [2010-11-17 07:43:53] [b98453cac15ba1066b407e146608df68]
- R PD    [Multiple Regression] [WS7.1] [2012-11-19 22:58:43] [6144fd9dab7e8876ce9100c6a2ac91c2] [Current]
Feedback Forum

Post a new message

Dataset

Dataseries X:
Download CSV
Histogram
Boxplots 
100	100	100	100
102.815	101.542	100.254	102
104.301	102.179	102.839	103.65
104.964	105.494	104.726	104.974
104.83	106.14	103.387	104.641
105.878	106.371	101.746	104.902
107.542	107.249	100.371	105.695
107.954	109.481	101.337	106.489
108.09	111.951	102.307	107.146
109.19	111.972	101.794	107.695
110.115	110.661	100.294	107.711
110.439	113.149	100.578	108.313
111.054	113.853	97.9592	108.124
112.319	115.143	100.107	109.615
113.607	116.923	102.865	111.34
112.716	116.638	102.719	110.717
113.126	116.227	103.921	111.217
112.818	115.942	105.751	111.452
112.565	116.42	106.746	111.611
112.698	113.365	108.454	111.717
113.701	112.709	107.724	112.062
113.844	115.609	108.936	112.842
114.151	115.626	109.764	113.241
114.069	116.697	108.502	113.015
114.798	119.368	109.211	113.998
114.537	120.264	113.097	114.936
114.118	118.74	112.18	114.245
113.814	116.522	114.855	114.437
115.232	116.967	114.53	115.286
115.945	118.061	115.328	116.071
117.543	118.711	117.973	117.807
118.205	119.223	117.863	118.255
119.899	119.196	116.582	118.969
121.35	120.729	117.645	120.333
122.563	121.828	120.711	121.998
124.143	122.603	121.37	123.239
126.574	123.803	120.473	124.666
128.069	127.692	122.204	126.54
128.101	128.336	124.943	127.336
128.752	128.718	125.276	127.871
129.991	130.539	130.192	130.115
133.236	132.864	131.595	132.773
134.689	134.529	133.091	134.265
135.058	135.166	133.167	134.596
135.615	133.458	131.858	134.38
136.088	135.621	132.5	135.121
136.114	137.409	131.551	135.136
136.177	138.866	131.422	135.336
136.883	135.802	131.112	135.284
139.095	139.408	131.193	137.144
141.551	142.191	136.448	140.349
144.647	146.027	138.433	143.264
147.403	145.695	136.323	144.381
148.778	148.469	137.453	145.881
149.123	152.221	137.072	146.497
150.925	157.061	139.485	148.857
152.195	160.782	142.049	150.78
155.762	164.581	141.315	153.293
159.863	171.274	145.023	157.641
164.488	177.848	148.287	162.182
172.288	185.538	147.732	167.86
181.098	193.704	151.23	175.245
186.026	203.366	150.278	179.32
191.144	213.692	154.789	184.979
196.021	220.819	153.029	188.482
200.338	225.005	157.658	192.86
202.319	229.096	161.039	195.475
204.148	233.982	165.599	198.4
205.288	234.529	171.248	200.598
206.439	238.753	172.249	202.121
210.638	238.258	177.164	205.875
212.831	241.42	174.947	207.085
214.227	242.44	179.407	209.204
216.573	248.809	181.625	212.246
217.504	254.991	188.871	215.466
219.151	255.458	189.866	216.693
220.494	261.125	192.114	219.019
220.484	258.58	189.665	217.924
220.269	257.981	191.006	217.978
222.524	257.756	186.398	218.186
221.905	257.984	189.577	218.54
222.286	252.604	190.244	217.886
219.929	251.688	190.269	216.347
222.144	255.734	196.606	219.825
224.73	257.646	197.796	221.956
228.912	263.016	205.874	227.184
231.613	265.367	206.229	229.247
235.936	271.406	208.473	233.33
239.005	278.478	211.102	236.987
242.293	284.415	211.503	240.027
248.077	287.685	218.055	245.433
248.956	287.97	221.076	246.641
252.358	290.44	226.743	250.328
254.122	292.298	223.179	250.849
255.015	296.637	219.996	251.435
253.493	299.882	223.847	252.091
255.976	292.588	227.227	252.946
255.878	292.523	226.757	252.773
254.149	290.063	223.928	250.677
252.408	296.831	220.682	250.105
252.503	296.742	227.654	251.788
253.733	296.479	218.398	250.212
252.299	295.557	213.639	248.073
248.838	288.037	212.71	244.468
247.559	287.377	217.355	244.727
245.331	290.101	217.786	244.034
242.351	296.679	218.186	243.588
238.172	285.712	206.917	236.447
226.723	270.085	197.833	224.906
225.84	261.006	194.438	221.934
225.751	266.44	202.508	224.903
226.192	267.075	196.651	223.798
220.037	263.672	191.446	218.529
220.406	259.121	190.056	217.521
223.551	262.711	190.322	219.971
223.373	265.838	203.701	223.841
224.678	265.766	200.524	223.764
223.629	269.162	200.524	223.664
220.855	256.573	191.582	217.678
220.127	257.917	195.727	218.478
215.471	253.316	194.766	214.815
214.691	257.496	194.576	215.143
216.2	264.861	198.563	218.381
219.85	257.795	201.679	219.962
220.182	251.318	201.506	218.933
220.283	243.526	204.453	218.36
216.675	247.503	206.552	217.72
217.808	256.9	205.642	219.934
217.66	261.806	205.679	220.842
217.951	260.758	204.583	220.584
215.9	244.361	204.484	216.346
217.141	255.116	208.73	220.221
219.459	256.46	210.264	222.182
222.898	258.249	214.211	225.455
225.478	256.327	214.169	226.42
228.098	259.192	213.656	228.287
230.729	260.776	219.028	231.349
230.535	261.166	217.602	231.015
229.735	265.351	220.635	232.241
233.148	261.627	222.011	233.688
235.221	266.932	224.948	236.667
237.46	268.695	225.566	238.439
239.951	274.37	219.318	239.488
240.436	275.671	213.558	238.741
241.588	270.831	214.026	238.5
241.512	275.141	225.59	242.116
243.05	277.59	227.637	243.923
246.469	276.357	229	245.813
248.64	279.389	226.841	247.143
251.147	274.787	221.488	246.381

Tables (Output of Computation)





Summary of computational transaction
Raw Inputview raw input (R code)
Raw Outputview raw output of R engine
Computing time1 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 & 1 seconds \tabularnewline
R Server & 'Sir Maurice George Kendall' @ kendall.wessa.net \tabularnewline
\hline
\end{tabular}
%Source: https://freestatistics.org/blog/index.php?pk=190845&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 Maurice George Kendall' @ kendall.wessa.net[/C][/ROW]
[/TABLE]
Source: https://freestatistics.org/blog/index.php?pk=190845&T=0

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

As an alternative you can also use a QR Code:  
QR Code


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

Summary of computational transaction
Raw Inputview raw input (R code)
Raw Outputview raw output of R engine
Computing time1 seconds
R Server'Sir Maurice George Kendall' @ kendall.wessa.net


Figures (Output of Computation)

Input Parameters & R Code

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 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('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
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
Forecast', 1, TRUE)
a<-table.element(a, 'Residuals
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')
}