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 computationFri, 20 Nov 2009 10:10:41 -0700
Cite this page as followsStatistical Computations at FreeStatistics.org, Office for Research Development and Education, URL https://freestatistics.org/blog/index.php?v=date/2009/Nov/20/t12587370961t03rruiwlpwmfq.htm/, Retrieved Thu, 28 Mar 2024 23:19:42 +0000
Statistical Computations at FreeStatistics.org, Office for Research Development and Education, URL https://freestatistics.org/blog/index.php?pk=58339, Retrieved Thu, 28 Mar 2024 23:19:42 +0000
QR Codes:

Original text written by user:
IsPrivate?No (this computation is public)
User-defined keywords
Estimated Impact176
Family? (F = Feedback message, R = changed R code, M = changed R Module, P = changed Parameters, D = changed Data)
-     [Notched Boxplots] [3/11/2009] [2009-11-02 21:10:41] [b98453cac15ba1066b407e146608df68]
-    D  [Notched Boxplots] [] [2009-11-09 10:28:17] [023d83ebdf42a2acf423907b4076e8a1]
- RMP     [Kendall tau Correlation Matrix] [] [2009-11-09 11:33:31] [023d83ebdf42a2acf423907b4076e8a1]
- RMPD      [Multiple Regression] [] [2009-11-20 15:57:46] [023d83ebdf42a2acf423907b4076e8a1]
-   PD          [Multiple Regression] [] [2009-11-20 17:10:41] [9f6463b67b1eb7bae5c03a796abf0348] [Current]
-    D            [Multiple Regression] [] [2009-11-20 17:15:11] [023d83ebdf42a2acf423907b4076e8a1]
Feedback Forum

Post a new message
Dataseries X:
Yt 	XT	XT-1 	Xt-2	XT-3	XT-4
100	100	91.12460521	94.04971502	97.82226485	100
97.82226485	99.87129987	93.13202153	91.12460521	94.04971502	97.82226485
94.04971502	99.54459954	93.88342812	93.13202153	91.12460521	94.04971502
91.12460521	99.81189981	92.55349954	93.88342812	93.13202153	91.12460521
93.13202153	100.4851005	94.43494835	92.55349954	93.88342812	93.13202153
93.88342812	101.1385011	96.25017563	94.43494835	92.55349954	93.88342812
92.55349954	101.3662014	100.4355715	96.25017563	94.43494835	92.55349954
94.43494835	101.5147015	101.5036685	100.4355715	96.25017563	94.43494835
96.25017563	101.8216018	99.39789728	101.5036685	100.4355715	96.25017563
100.4355715	102.4354024	99.68990733	99.39789728	101.5036685	100.4355715
101.5036685	102.5344025	101.6895041	99.68990733	99.39789728	101.5036685
99.39789728	102.6532027	103.6652759	101.6895041	99.68990733	99.39789728
99.68990733	102.4651025	103.0532766	103.6652759	101.6895041	99.68990733
101.6895041	102.4354024	100.9500712	103.0532766	103.6652759	101.6895041
103.6652759	102.4156024	102.345366	100.9500712	103.0532766	103.6652759
103.0532766	102.4453024	101.6472299	102.345366	100.9500712	103.0532766
100.9500712	102.8908029	99.56809393	101.6472299	102.345366	100.9500712
102.345366	102.8512029	95.67727392	99.56809393	101.6472299	102.345366
101.6472299	103.3561034	96.58494865	95.67727392	99.56809393	101.6472299
99.56809393	103.7422037	96.32604937	96.58494865	95.67727392	99.56809393
95.67727392	103.7224037	95.37109101	96.32604937	96.58494865	95.67727392
96.58494865	104.0788041	96.00056203	95.37109101	96.32604937	96.58494865
96.32604937	104.2075042	96.88367859	96.00056203	95.37109101	96.32604937
95.37109101	103.9105039	94.85280372	96.88367859	96.00056203	95.37109101
96.00056203	103.7026037	92.46943974	94.85280372	96.88367859	96.00056203
96.88367859	103.960004	93.99180173	92.46943974	94.85280372	96.88367859
94.85280372	104.0986041	93.45262168	93.99180173	92.46943974	94.85280372
92.46943974	104.1481041	92.26698759	93.45262168	93.99180173	92.46943974
93.99180173	104.7124047	90.39653498	92.26698759	93.45262168	93.99180173
93.45262168	104.7223047	90.43001228	90.39653498	92.26698759	93.45262168
92.26698759	105.1975052	91.04995327	90.43001228	90.39653498	92.26698759
90.39653498	105.0688051	89.07845784	91.04995327	90.43001228	90.39653498
90.43001228	105.0589051	89.69314509	89.07845784	91.04995327	90.43001228
91.04995327	105.5044055	87.92459054	89.69314509	89.07845784	91.04995327
89.07845784	105.3757054	85.8789319	87.92459054	89.69314509	89.07845784
89.69314509	105.4747055	83.20612366	85.8789319	87.92459054	89.69314509
87.92459054	106.029106	83.85722053	83.20612366	85.8789319	87.92459054
85.8789319	107.019107	83.01393462	83.85722053	83.20612366	85.8789319
83.20612366	107.3161073	82.84508195	83.01393462	83.85722053	83.20612366
83.85722053	107.7517078	78.68864276	82.84508195	83.01393462	83.85722053
83.01393462	108.5239085	77.56959675	78.68864276	82.84508195	83.01393462
82.84508195	109.3159093	78.53689529	77.56959675	78.68864276	82.84508195
78.68864276	109.5634096	78.55717715	78.53689529	77.56959675	78.68864276
77.56959675	110.5435105	77.4761291	78.55717715	78.53689529	77.56959675
78.53689529	111.1573112	81.58931659	77.4761291	78.55717715	78.53689529
78.55717715	111.7414117	85.02428326	81.58931659	77.4761291	78.55717715
77.4761291	111.0583111	91.71290159	85.02428326	81.58931659	77.4761291
81.58931659	111.2365112	95.96293061	91.71290159	85.02428326	81.58931659
85.02428326	111.038511	90.84689022	95.96293061	91.71290159	85.02428326
91.71290159	110.3752104	92.28788036	90.84689022	95.96293061	91.71290159
95.96293061	110.1376101	95.56511274	92.28788036	90.84689022	95.96293061
90.84689022	110.2465102	93.62452884	95.56511274	92.28788036	90.84689022
92.28788036	110.6227106	92.63071726	93.62452884	95.56511274	92.28788036
95.56511274	109.98911	89.50914211	92.63071726	93.62452884	95.56511274
93.62452884	110.2168102	87.17171779	89.50914211	92.63071726	93.62452884
92.63071726	110.1376101	86.72624975	87.17171779	89.50914211	92.63071726
89.50914211	109.9297099	85.63212844	86.72624975	87.17171779	89.50914211




Summary of computational transaction
Raw Inputview raw input (R code)
Raw Outputview raw output of R engine
Computing time1 seconds
R Server'Gwilym Jenkins' @ 72.249.127.135
R Engine error message
Error in as.vector(data) : object 'Yt' not found
Calls: array -> as.vector
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 & 'Gwilym Jenkins' @ 72.249.127.135 \tabularnewline
R Engine error message & 
Error in as.vector(data) : object 'Yt' not found
Calls: array -> as.vector
Execution halted
\tabularnewline \hline \end{tabular} %Source: https://freestatistics.org/blog/index.php?pk=58339&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]'Gwilym Jenkins' @ 72.249.127.135[/C][/ROW]
[ROW][C]R Engine error message[/C][C]
Error in as.vector(data) : object 'Yt' not found
Calls: array -> as.vector
Execution halted
[/C][/ROW] [/TABLE] Source: https://freestatistics.org/blog/index.php?pk=58339&T=0

Globally Unique Identifier (entire table): ba.freestatistics.org/blog/index.php?pk=58339&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 Inputview raw input (R code)
Raw Outputview raw output of R engine
Computing time1 seconds
R Server'Gwilym Jenkins' @ 72.249.127.135
R Engine error message
Error in as.vector(data) : object 'Yt' not found
Calls: array -> as.vector
Execution halted



Parameters (Session):
par1 = 1 ; par2 = Include Monthly Dummies ; par3 = Linear Trend ;
Parameters (R input):
par1 = 1 ; par2 = Include Monthly Dummies ; par3 = 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')
}