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 computationTue, 30 Oct 2012 14:20:58 -0400
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/Oct/30/t1351621273218z4ul4g6htlcw.htm/, Retrieved Fri, 03 May 2024 15:42:38 +0000
Statistical Computations at FreeStatistics.org, Office for Research Development and Education, URL https://freestatistics.org/blog/index.php?pk=185277, Retrieved Fri, 03 May 2024 15:42:38 +0000
QR Codes:

Original text written by user:
IsPrivate?No (this computation is public)
User-defined keywords
Estimated Impact126
Family? (F = Feedback message, R = changed R code, M = changed R Module, P = changed Parameters, D = changed Data)
-       [Multiple Regression] [WS 7 ] [2012-10-30 18:20:58] [18a55f974a2e8651a7d8da0218fcbdb6] [Current]
Feedback Forum

Post a new message
Dataseries X:
10	43	44	124	15	26	-	262
12	50	54	97	22	29	3	267
10	88	71	165	39	39	2	414
7	58	61	139	28	20	-	313
9	59	44	118	24	30	1	285
11	70	59	155	25	35	-	355
13	75	54	137	41	33	-	353
12	51	46	143	31	25	1	309
8	65	57	159	25	38	1	353
11	49	47	130	29	15	3	284
18	62	56	147	38	30	-	351
15	74	68	134	18	28	-	337
14	46	72	132	25	24	1	314
10	52	60	138	35	21	1	317
9	71	77	169	36	26	1	389
2	61	45	116	33	19	1	277
12	56	58	107	27	22	-	282
9	91	89	124	26	24	2	365
11	50	37	124	22	21	1	266
14	58	56	153	26	39	1	347
8	50	66	136	29	25	-	314
4	49	56	117	25	19	-	270
14	56	54	170	24	34	1	353
9	39	38	127	32	20	-	265
10	45	53	127	29	29	-	293
9	26	64	130	34	14	1	278
10	51	68	125	45	19	1	319
9	50	58	124	20	11	-	272
3	43	46	121	41	15	2	271
3	47	41	118	36	25	2	272
4	36	43	128	28	22	-	261
6	46	45	125	35	17	1	275
11	43	43	122	31	15	4	269
19	41	57	135	37	18	1	308
11	38	48	145	27	21	-	290
9	26	34	111	20	21	2	223
7	49	56	157	34	10	-	313
7	37	55	129	25	15	1	269
2	56	52	118	29	11	-	268
10	36	57	113	25	18	1	260
7	42	56	122	27	13	-	267
3	35	48	130	32	13	1	262
6	36	44	127	26	14	1	254
3	36	61	101	26	9	-	236
7	37	55	116	29	13	1	258
11	50	46	140	29	25	2	303
6	38	51	98	24	14	2	233
6	40	43	95	32	20	1	237
7	54	40	131	36	14	2	284
4	35	55	117	35	17	-	263
7	47	47	81	33	21	-	236
4	46	44	123	18	16	-	251
9	37	57	104	28	19	1	255
8	45	38	99	28	17	-	235
7	37	48	133	22	29	1	277
6	38	33	88	26	16	-	207
9	43	66	112	30	14	-	274
2	46	47	137	24	17	-	273
8	34	60	103	28	23	2	258
9	34	45	116	24	15	3	246
7	32	52	103	22	12	-	228
7	31	36	113	23	15	2	227
2	50	50	134	30	14	1	281
13	34	62	110	26	14	1	260
6	26	36	84	28	17	1	198
4	42	54	110	30	12	-	252
6	40	45	100	26	14	1	232
2	36	46	76	17	13	-	190
5	48	71	123	33	24	-	304
3	33	40	88	29	21	-	214
7	37	42	77	21	10	1	195
4	37	37	76	11	17	1	183
3	24	37	65	14	9	-	152
9	37	42	76	15	15	-	194
9	34	60	103	23	16	-	245
4	22	50	91	24	13	4	208
1	33	31	83	10	9	-	167
2	40	42	98	11	26	1	220
4	32	33	65	7	10	1	152
1	32	40	68	13	6	3	163
2	30	35	74	18	14	2	175
5	20	42	64	16	9	2	158
2	26	35	90	14	14	2	183
4	35	34	77	14	10	-	174
3	32	42	59	15	11	1	163
5	36	40	83	20	11	-	195
2	35	60	79	19	10	-	205
4	22	40	60	14	13	1	154
6	40	47	84	20	19	1	217
1	30	31	78	12	10	1	163
1	34	31	77	13	16	3	175
6	37	47	100	17	21	-	228
2	25	42	79	15	17	-	180
6	41	52	103	14	18	1	235
3	40	62	85	19	40	1	250
3	25	46	74	17	18	-	183
4	34	59	90	11	24	1	223
2	25	49	97	20	16	2	211
2	32	54	68	16	31	1	204
4	19	70	85	12	15	1	206
6	46	60	103	22	18	1	256
3	27	43	80	15	24	-	192
4	48	52	92	21	21	-	238
7	49	61	100	12	19	-	248
-	43	53	84	12	18	1	211
5	55	63	94	17	27	-	261
4	52	55	80	17	15	1	224
4	40	35	89	17	12	-	197
7	54	68	124	18	26	-	297
3	47	58	99	10	24	-	241
2	52	43	100	10	35	-	242
3	38	45	79	9	21	1	196
2	53	56	96	11	30	1	249
5	43	51	100	18	32	1	250
7	56	55	115	15	55	1	304
3	42	48	74	15	39	-	221
2	50	49	77	18	48	1	245
12	52	58	108	22	50	3	305
4	38	43	64	13	52	1	215
9	48	45	83	14	51	1	251
6	57	68	103	20	47	2	303
12	50	63	96	24	45	-	290
9	47	76	106	16	41	1	296
8	59	109	122	30	49	1	378
8	72	95	105	21	59	-	360
5	79	86	112	23	51	2	358
9	74	68	105	21	62	1	340
4	64	57	96	20	35	-	276
10	77	79	144	27	74	-	411
8	67	70	113	16	67	2	343
5	61	62	112	28	48	3	319
6	49	65	113	25	56	1	315
12	57	62	126	43	54	1	355
17	43	77	116	30	70	1	354
22	96	94	156	42	74	-	484
7	60	76	91	23	60	-	317
10	65	65	108	19	60	-	327
19	67	71	151	19	77	2	406
7	44	52	132	36	55	2	328
11	71	78	120	20	64	1	365
17	43	67	160	27	55	2	371
9	57	61	118	24	49	1	319
15	59	94	155	23	62	2	410
18	45	77	122	26	54	3	345
9	47	86	123	31	59	3	358
4	46	72	146	51	73	1	393
12	58	102	156	39	72	-	439
16	52	57	127	32	58	-	342
9	46	94	128	30	59	1	367
7	51	97	147	46	62	2	412
11	50	67	128	31	50	4	341
14	51	70	139	31	51	4	360
4	76	74	130	40	74	1	399
8	47	59	118	29	49	4	314
12	47	65	147	43	68	1	383
13	53	71	98	17	62	2	316
15	45	63	141	53	41	2	360
9	39	58	138	47	60	1	352
7	44	72	130	49	53	-	355
16	39	53	145	44	44	1	342
9	48	73	123	48	50	4	355
11	42	62	116	51	48	2	332
4	30	77	90	47	47	1	296
10	37	98	110	44	50	4	353
12	30	70	102	33	41	3	291
8	36	56	109	47	46	3	305
9	37	67	111	41	40	2	307
12	30	33	93	36	47	2	253
3	50	48	120	46	41	5	313
4	29	52	81	24	33	1	224
9	25	69	84	17	29	5	238
5	34	55	87	22	33	1	237
4	42	52	110	30	35	3	276
4	26	43	90	24	39	1	227
2	28	49	108	18	40	5	250
7	25	68	101	24	45	3	273
4	39	59	87	24	34	2	249
13	51	48	118	28	50	5	313
6	43	50	82	19	38	1	239
7	27	44	86	22	27	1	214
3	31	57	103	26	31	3	254
10	22	50	93	14	35	1	225
5	19	52	83	16	33	5	213
5	38	74	91	21	25	3	257
3	24	35	69	15	22	1	169
4	35	37	95	23	48	-	242
4	29	53	96	29	33	4	248
9	30	45	105	17	37	-	243
5	34	62	121	24	30	2	278
7	28	57	101	18	51	5	267
6	55	68	111	22	52	4	318
8	46	69	130	8	49	3	313
7	67	83	134	26	43	9	369
4	71	81	161	22	51	3	393
4	113	95	186	34	63	1	496
5	62	89	244	25	65	2	492
12	43	84	145	20	63	2	369
11	105	87	170	35	93	15	516
11	63	100	164	38	78	5	459
11	67	63	124	24	62	5	356
15	73	94	154	14	99	-	449
17	60	95	126	25	67	6	396
11	58	95	173	31	74	8	450
12	71	98	140	17	59	6	403
10	65	83	142	32	62	3	397
13	65	121	129	27	54	5	414
13	77	148	171	30	58	5	502
14	65	93	107	19	58	-	356
3	41	79	98	36	34	1	292
7	105	129	185	27	57	13	523
4	54	85	142	28	47	-	360
9	63	86	135	38	36	2	369
10	52	88	126	26	45	3	350
7	106	92	126	25	39	11	406
13	76	86	134	30	57	9	405
12	54	69	119	27	33	2	316
15	61	103	134	30	45	4	392
14	51	112	133	50	49	-	409
12	65	87	129	48	62	6	409
5	65	82	96	34	42	1	325
5	71	82	150	41	57	6	412
6	31	71	113	26	42	3	292
7	52	64	99	39	49	3	313
9	53	97	164	33	36	12	404
2	80	130	127	38	34	7	418
6	71	114	148	28	49	2	418
21	82	117	166	36	61	2	485
16	53	89	115	20	78	3	374
14	73	121	199	39	60	7	513
12	66	142	141	22	97	12	492
8	53	117	149	32	87	7	453
5	82	143	131	32	77	6	476
19	100	131	171	31	66	12	530
9	74	125	178	28	52	5	471
12	73	147	181	44	91	8	556
12	64	107	129	40	55	3	410




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

Globally Unique Identifier (entire table): ba.freestatistics.org/blog/index.php?pk=185277&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'Herman Ole Andreas Wold' @ wold.wessa.net



Parameters (Session):
par1 = 8 ; par2 = Do not include Seasonal Dummies ; par3 = No Linear Trend ;
Parameters (R input):
par1 = 8 ; 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')
}