Home » date » 2008 » Feb » 07 » attachments

Viskositaetn

R Software Module: rwasp_multipleregression.wasp (opens new window with default values)
Title produced by software: Multiple Regression
Date of computation: Thu, 07 Feb 2008 07:09:41 -0700
 
Cite this page as follows:
Statistical Computations at FreeStatistics.org, Office for Research Development and Education, URL http://www.freestatistics.org/blog/date/2008/Feb/07/t1202393486apytdw6gvvbalm3.htm/, Retrieved Thu, 07 Feb 2008 15:11:26 +0100
 
User-defined keywords:
 
Dataseries X:
» Textbox « » Textfile « » CSV «
50 105 20 51.6 50 105 40 154 50 105 60 473 50 105 80 1473 100 105 80 673 100 105 60 236 100 105 40 84.1 100 105 20 30.9 250 105 20 15.8 250 105 40 37.8 250 105 60 93.4 250 105 80 236 250 105 100 603 250 105 120 1549 250 105 120 579 500 105 100 247 500 105 80 106 500 105 60 46.3 500 105 40 20.7 500 105 20 9.46 1000 105 20 5.68 1000 105 40 11.3 1000 105 60 23.1 1000 105 80 47.9 1000 105 100 101 1000 105 120 215 1000 105 120 126 2000 105 90 44 2000 105 70 22.2 2000 105 50 11.4 2000 105 20 4.31 2000 105 40 8.2 5000 105 20 3.11 5000 105 40 5.62 5000 105 60 10.3 5000 105 80 19 5000 105 100 35.5 5000 105 120 67.2 3500 200 120 54.8 3500 200 100 29.6 3500 200 80 16.1 3500 200 60 8.9 3500 200 40 4.97 3500 200 20 2.8 2000 200 20 3.31 2000 200 40 6.04 2000 200 60 11.1 2000 200 80 20.8 2000 200 100 39.5 2000 200 120 75.7 1000 200 120 123 1000 200 100 61 1000 200 80 30.6 1000 200 60 15.6 1000 200 40 8.08 1000 200 20 4.26 500 200 20 7.07 500 200 40 14.7 500 200 60 31.1 500 200 80 67.4 500 200 100 148 500 200 120 329 300 200 120 683 300 200 100 287 300 200 80 121 300 200 60 52.1 300 200 40 22.9 300 200 20 10.3 150 200 20 17.2 150 200 40 41.9 150 200 60 105 150 200 90 435 150 200 110 1132 75 200 90 1007 75 200 60 212 75 200 20 28.6 75 200 75 461 40 200 20 45.6 40 200 40 133 40 200 60 400 40 200 80 1220 10 200 20 128 10 200 30 236 10 200 40 466 10 200 50 844 5 500 50 960 5 500 40 504 5 500 30 266 5 500 20 141 10 500 20 84.2 10 500 40 274 10 500 60 918 10 500 50 501 50 500 50 109 50 500 70 299 50 500 90 830 110 500 90 317 110 500 110 798 110 500 60 80.9 110 500 40 33.4 110 500 20 14.2 110 500 30 21.7 300 500 25 8.11 300 500 50 20.2 300 500 40 14 300 500 70 43 300 500 100 138 300 500 120 304 700 500 120 92.8 700 500 100 47.4 700 500 80 24.5 700 500 40 6.83 700 500 20 3.68 1500 500 20 2.58 1500 500 40 4.51 1500 500 60 7.97 1500 500 90 19.1 1500 500 120 46.8 1700 500 120 44.5 1700 500 70 10.2 1700 500 40 4.37 1700 500 20 2.51 1700 500 95 21.2 670 500 95 25.8 670 990 120 55.9 670 990 70 12.1 670 990 40 5.03 670 990 20 2.83 300 990 20 4.89 300 990 40 9.51 300 990 60 16.8 300 990 90 54.2 300 990 120 161 100 990 120 752 100 990 90 202 100 990 65 69 100 990 40 24.2 100 990 20 10.8 50 990 20 18.1 50 990 40 44.5 50 990 60 113 50 990 80 292 50 990 100 766 20 990 100 2478 20 990 80 841 20 990 60 287 20 990 40 99.7 20 990 20 35.7 10 990 20 60 10 990 40 184 10 990 60 580 10 990 70 1038 2 990 50 1490 2 990 40 760 2 990 30 389 2 990 20 201 7 990 20 78.4 7 990 30 140 7 990 40 252 7 990 60 833 2 2100 20 144 2 2100 30 272 2 2100 40 517 2 2100 50 987 5 2100 50 413 5 2100 60 748 5 2100 40 229 5 2100 30 128 5 2100 20 723 10 2100 20 42.9 10 2100 40 124 10 2100 60 369 10 2100 70 640 50 2100 70 111 50 2100 90 272 50 2100 120 1061 50 2100 40 29.9 50 2100 20 12.9 100 2100 20 7.81 100 2100 40 16.5 100 2100 70 52.9 100 2100 90 118 100 2100 120 399 180 2100 120 179 180 2100 100 85.4 180 2100 80 41.3 180 2100 60 203 180 2100 40 10.1 180 2100 20 5.17 35000 20 20 2.9 35000 20 40 5.16 35000 20 60 9.3 35000 20 80 17 35000 20 100 31.3 35000 20 120 58.5 20000 20 120 82.4 20000 20 100 42.7 20000 20 80 22.3 20000 20 60 11.8 20000 20 40 6.37 20000 20 20 3.46 10000 20 20 4.5 10000 20 40 8.62 10000 20 70 23.6 10000 20 90 47.2 10000 20 120 137 5000 20 120 236 5000 20 90 75.3 5000 20 70 35.6 5000 20 40 12 5000 20 20 5.97 2500 20 20 8 2500 20 40 17 2500 20 60 36.8 2500 20 80 81.7 2500 20 100 184 2500 20 120 418 1000 20 120 896 1000 20 100 367 1000 20 80 151 1000 20 60 63.2 1000 20 40 27 1000 20 20 11.9 500 20 20 19.7 500 20 40 49.23 500 20 60 127 500 20 80 334 500 20 100 890 1000 46 40 17.5 1000 46 60 38.2 1000 46 80 85 1000 46 100 193 1000 46 120 440 500 46 120 1179 500 46 100 471 500 46 80 189 500 46 60 76.8 500 46 40 31.9 500 46 20 13.7 1500 46 20 6.92 1500 46 40 14.3 1500 46 60 30.2 1500 46 80 65.1 1500 46 100 143 1500 46 120 315 2000 46 120 250 2000 46 100 115 2000 46 80 54 2000 46 60 25.6 2000 46 40 12.4 2000 46 20 6.14 3000 46 20 5.19 3000 46 40 10.2 3000 46 60 20.4 3000 46 80 41.7 3000 46 100 86.3 3000 46 120 180 5000 46 120 122 5000 46 100 60.6 5000 46 80 30.4 5000 46 60 15.5 5000 46 40 8.05 5000 46 20 4.24 10000 46 20 3.3 10000 46 40 6 10000 46 60 11.1 10000 46 80 20.7 10000 46 100 39.2 10000 46 120 75
 
Text written by user:
 
Output produced by software:

Enter (or paste) a matrix (table) containing all data (time) series. Every column represents a different variable and must be delimited by a space or Tab. Every row represents a period in time (or category) and must be delimited by hard returns. The easiest way to enter data is to copy and paste a block of spreadsheet cells. Please, do not use commas or spaces to seperate groups of digits!


Summary of compuational transaction
Raw Inputview raw input (R code)
Raw Outputview raw output of R engine
Computing time1 seconds
R Server'George Udny Yule' @ 72.249.76.132
 
Charts produced by software:
 
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('http://www.xycoon.com/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<br />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<br />Forecast', 1, TRUE)
a<-table.element(a, 'Residuals<br />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')
}
 




Copyright

Creative Commons License

This work is licensed under a Creative Commons Attribution-Noncommercial-Share Alike 3.0 License.

Software written by Ed van Stee & Patrick Wessa


Disclaimer

Information provided on this web site is provided "AS IS" without warranty of any kind, either express or implied, including, without limitation, warranties of merchantability, fitness for a particular purpose, and noninfringement. We use reasonable efforts to include accurate and timely information and periodically update the information, and software without notice. However, we make no warranties or representations as to the accuracy or completeness of such information (or software), and we assume no liability or responsibility for errors or omissions in the content of this web site, or any software bugs in online applications. Your use of this web site is AT YOUR OWN RISK. Under no circumstances and under no legal theory shall we be liable to you or any other person for any direct, indirect, special, incidental, exemplary, or consequential damages arising from your access to, or use of, this web site.


Privacy Policy

We may request personal information to be submitted to our servers in order to be able to:

  • personalize online software applications according to your needs
  • enforce strict security rules with respect to the data that you upload (e.g. statistical data)
  • manage user sessions of online applications
  • alert you about important changes or upgrades in resources or applications

We NEVER allow other companies to directly offer registered users information about their products and services. Banner references and hyperlinks of third parties NEVER contain any personal data of the visitor.

We do NOT sell, nor transmit by any means, personal information, nor statistical data series uploaded by you to third parties.

We carefully protect your data from loss, misuse, alteration, and destruction. However, at any time, and under any circumstance you are solely responsible for managing your passwords, and keeping them secret.

We store a unique ANONYMOUS USER ID in the form of a small 'Cookie' on your computer. This allows us to track your progress when using this website which is necessary to create state-dependent features. The cookie is used for NO OTHER PURPOSE. At any time you may opt to disallow cookies from this website - this will not affect other features of this website.

We examine cookies that are used by third-parties (banner and online ads) very closely: abuse from third-parties automatically results in termination of the advertising contract without refund. We have very good reason to believe that the cookies that are produced by third parties (banner ads) do NOT cause any privacy or security risk.

FreeStatistics.org is safe. There is no need to download any software to use the applications and services contained in this website. Hence, your system's security is not compromised by their use, and your personal data - other than data you submit in the account application form, and the user-agent information that is transmitted by your browser - is never transmitted to our servers.

As a general rule, we do not log on-line behavior of individuals (other than normal logging of webserver 'hits'). However, in cases of abuse, hacking, unauthorized access, Denial of Service attacks, illegal copying, hotlinking, non-compliance with international webstandards (such as robots.txt), or any other harmful behavior, our system engineers are empowered to log, track, identify, publish, and ban misbehaving individuals - even if this leads to ban entire blocks of IP addresses, or disclosing user's identity.

FreeStatistics.org is powered by