Send output to:
Browser Blue - Charts White
Browser Black/White
CSV
Data X:
2498 1 0 0 0 0 0 0 0 0 0 0 0 0 2296 2 1 0 0 0 0 0 0 0 0 0 0 0 2465 3 0 1 0 0 0 0 0 0 0 0 0 0 2475 4 0 0 1 0 0 0 0 0 0 0 0 0 2542 5 0 0 0 1 0 0 0 0 0 0 0 0 2434 6 0 0 0 0 1 0 0 0 0 0 0 0 2550 7 0 0 0 0 0 1 0 0 0 0 0 0 2589 8 0 0 0 0 0 0 1 0 0 0 0 0 2251 9 0 0 0 0 0 0 0 1 0 0 0 0 2439 10 0 0 0 0 0 0 0 0 1 0 0 0 2424 11 0 0 0 0 0 0 0 0 0 1 0 0 2236 12 0 0 0 0 0 0 0 0 0 0 0 1 2592 13 0 0 0 0 0 0 0 0 0 0 0 0 2338 14 1 0 0 0 0 0 0 0 0 0 0 0 2520 15 0 1 0 0 0 0 0 0 0 0 0 0 2483 16 0 0 1 0 0 0 0 0 0 0 0 0 2622 17 0 0 0 1 0 0 0 0 0 0 0 0 2445 18 0 0 0 0 1 0 0 0 0 0 0 0 2482 19 0 0 0 0 0 1 0 0 0 0 0 0 2556 20 0 0 0 0 0 0 1 0 0 0 0 0 2336 21 0 0 0 0 0 0 0 1 0 0 0 0 2480 22 0 0 0 0 0 0 0 0 1 0 0 0 2273 23 0 0 0 0 0 0 0 0 0 1 0 0 2223 24 0 0 0 0 0 0 0 0 0 0 0 1 2510 25 0 0 0 0 0 0 0 0 0 0 0 0 2328 26 1 0 0 0 0 0 0 0 0 0 0 0 2546 27 0 1 0 0 0 0 0 0 0 0 0 0 2599 28 0 0 1 0 0 0 0 0 0 0 0 0 2747 29 0 0 0 1 0 0 0 0 0 0 0 0 2560 30 0 0 0 0 1 0 0 0 0 0 0 0 2746 31 0 0 0 0 0 1 0 0 0 0 0 0 2674 32 0 0 0 0 0 0 1 0 0 0 0 0 2407 33 0 0 0 0 0 0 0 1 0 0 0 0 2589 34 0 0 0 0 0 0 0 0 1 0 0 0 2513 35 0 0 0 0 0 0 0 0 0 1 0 0 2403 36 0 0 0 0 0 0 0 0 0 0 0 1 2760 37 0 0 0 0 0 0 0 0 0 0 0 0 2418 38 1 0 0 0 0 0 0 0 0 0 0 0 2611 39 0 1 0 0 0 0 0 0 0 0 0 0 2754 40 0 0 1 0 0 0 0 0 0 0 0 0 2775 41 0 0 0 1 0 0 0 0 0 0 0 0 2588 42 0 0 0 0 1 0 0 0 0 0 0 0 2813 43 0 0 0 0 0 1 0 0 0 0 0 0 2791 44 0 0 0 0 0 0 1 0 0 0 0 0 2648 45 0 0 0 0 0 0 0 1 0 0 0 0 2589 46 0 0 0 0 0 0 0 0 1 0 0 0 2481 47 0 0 0 0 0 0 0 0 0 1 0 0 2427 48 0 0 0 0 0 0 0 0 0 0 0 1 2692 49 0 0 0 0 0 0 0 0 0 0 0 0 2302 50 1 0 0 0 0 0 0 0 0 0 0 0 2773 51 0 1 0 0 0 0 0 0 0 0 0 0 2637 52 0 0 1 0 0 0 0 0 0 0 0 0 2785 53 0 0 0 1 0 0 0 0 0 0 0 0 2803 54 0 0 0 0 1 0 0 0 0 0 0 0 2767 55 0 0 0 0 0 1 0 0 0 0 0 0 2693 56 0 0 0 0 0 0 1 0 0 0 0 0 2559 57 0 0 0 0 0 0 0 1 0 0 0 0 2564 58 0 0 0 0 0 0 0 0 1 0 0 0 2499 59 0 0 0 0 0 0 0 0 0 1 0 0 2410 60 0 0 0 0 0 0 0 0 0 0 0 1 2624 61 0 0 0 0 0 0 0 0 0 0 0 0 2509 62 1 0 0 0 0 0 0 0 0 0 0 0 2845 63 0 1 0 0 0 0 0 0 0 0 0 0 2718 64 0 0 1 0 0 0 0 0 0 0 0 0 2771 65 0 0 0 1 0 0 0 0 0 0 0 0 2722 66 0 0 0 0 1 0 0 0 0 0 0 0 2911 67 0 0 0 0 0 1 0 0 0 0 0 0 2743 68 0 0 0 0 0 0 1 0 0 0 0 0 2715 69 0 0 0 0 0 0 0 1 0 0 0 0 2772 70 0 0 0 0 0 0 0 0 1 0 0 0 2642 71 0 0 0 0 0 0 0 0 0 1 0 0 2467 72 0 0 0 0 0 0 0 0 0 0 0 1 2703 73 0 0 0 0 0 0 0 0 0 0 0 0 2454 74 1 0 0 0 0 0 0 0 0 0 0 0 2826 75 0 1 0 0 0 0 0 0 0 0 0 0 2804 76 0 0 1 0 0 0 0 0 0 0 0 0 2896 77 0 0 0 1 0 0 0 0 0 0 0 0 2763 78 0 0 0 0 1 0 0 0 0 0 0 0 2833 79 0 0 0 0 0 1 0 0 0 0 0 0 2752 80 0 0 0 0 0 0 1 0 0 0 0 0 2770 81 0 0 0 0 0 0 0 1 0 0 0 0 2718 82 0 0 0 0 0 0 0 0 1 0 0 0 2572 83 0 0 0 0 0 0 0 0 0 1 0 0 2546 84 0 0 0 0 0 0 0 0 0 0 0 1 2730 85 0 0 0 0 0 0 0 0 0 0 0 0 2424 86 1 0 0 0 0 0 0 0 0 0 0 0 2763 87 0 1 0 0 0 0 0 0 0 0 0 0 2844 88 0 0 1 0 0 0 0 0 0 0 0 0 2952 89 0 0 0 1 0 0 0 0 0 0 0 0 2875 90 0 0 0 0 1 0 0 0 0 0 0 0 2984 91 0 0 0 0 0 1 0 0 0 0 0 0 2810 92 0 0 0 0 0 0 1 0 0 0 0 0 2724 93 0 0 0 0 0 0 0 1 0 0 0 0 2866 94 0 0 0 0 0 0 0 0 1 0 0 0 2697 95 0 0 0 0 0 0 0 0 0 1 0 0 2631 96 0 0 0 0 0 0 0 0 0 0 0 1 2841 97 0 0 0 0 0 0 0 0 0 0 0 0 2473 98 1 0 0 0 0 0 0 0 0 0 0 0 2954 99 0 1 0 0 0 0 0 0 0 0 0 0 2792 100 0 0 1 0 0 0 0 0 0 0 0 0 3089 101 0 0 0 1 0 0 0 0 0 0 0 0 2915 102 0 0 0 0 1 0 0 0 0 0 0 0 3088 103 0 0 0 0 0 1 0 0 0 0 0 0 2998 104 0 0 0 0 0 0 1 0 0 0 0 0 2951 105 0 0 0 0 0 0 0 1 0 0 0 0 2991 106 0 0 0 0 0 0 0 0 1 0 0 0 2794 107 0 0 0 0 0 0 0 0 0 1 0 0 2712 108 0 0 0 0 0 0 0 0 0 0 0 1 3036 109 0 0 0 0 0 0 0 0 0 0 0 0 2785 110 1 0 0 0 0 0 0 0 0 0 0 0 3044 111 0 1 0 0 0 0 0 0 0 0 0 0 3058 112 0 0 1 0 0 0 0 0 0 0 0 0 3166 113 0 0 0 1 0 0 0 0 0 0 0 0 3096 114 0 0 0 0 1 0 0 0 0 0 0 0 3128 115 0 0 0 0 0 1 0 0 0 0 0 0 3024 116 0 0 0 0 0 0 1 0 0 0 0 0 3115 117 0 0 0 0 0 0 0 1 0 0 0 0 3011 118 0 0 0 0 0 0 0 0 1 0 0 0 2812 119 0 0 0 0 0 0 0 0 0 1 0 0 2760 120 0 0 0 0 0 0 0 0 0 0 0 1 2976 121 0 0 0 0 0 0 0 0 0 0 0 0 2720 122 1 0 0 0 0 0 0 0 0 0 0 0 3044 123 0 1 0 0 0 0 0 0 0 0 0 0 3027 124 0 0 1 0 0 0 0 0 0 0 0 0 3266 125 0 0 0 1 0 0 0 0 0 0 0 0 3254 126 0 0 0 0 1 0 0 0 0 0 0 0 3246 127 0 0 0 0 0 1 0 0 0 0 0 0 3305 128 0 0 0 0 0 0 1 0 0 0 0 0 3265 129 0 0 0 0 0 0 0 1 0 0 0 0 3126 130 0 0 0 0 0 0 0 0 1 0 0 0 2833 131 0 0 0 0 0 0 0 0 0 1 0 0 2847 132 0 0 0 0 0 0 0 0 0 0 0 1 3066 133 0 0 0 0 0 0 0 0 0 0 0 0 2785 134 1 0 0 0 0 0 0 0 0 0 0 0 3251 135 0 1 0 0 0 0 0 0 0 0 0 0 3238 136 0 0 1 0 0 0 0 0 0 0 0 0 3419 137 0 0 0 1 0 0 0 0 0 0 0 0 3286 138 0 0 0 0 1 0 0 0 0 0 0 0 3450 139 0 0 0 0 0 1 0 0 0 0 0 0 3447 140 0 0 0 0 0 0 1 0 0 0 0 0 3153 141 0 0 0 0 0 0 0 1 0 0 0 0 3233 142 0 0 0 0 0 0 0 0 1 0 0 0 2992 143 0 0 0 0 0 0 0 0 0 1 0 0 3044 144 0 0 0 0 0 0 0 0 0 0 0 1 3155 145 0 0 0 0 0 0 0 0 0 0 0 0 2778 146 1 0 0 0 0 0 0 0 0 0 0 0 3392 147 0 1 0 0 0 0 0 0 0 0 0 0 3446 148 0 0 1 0 0 0 0 0 0 0 0 0 3466 149 0 0 0 1 0 0 0 0 0 0 0 0 3355 150 0 0 0 0 1 0 0 0 0 0 0 0 3573 151 0 0 0 0 0 1 0 0 0 0 0 0 3498 152 0 0 0 0 0 0 1 0 0 0 0 0 3332 153 0 0 0 0 0 0 0 1 0 0 0 0 3306 154 0 0 0 0 0 0 0 0 1 0 0 0 3136 155 0 0 0 0 0 0 0 0 0 1 0 0 3081 156 0 0 0 0 0 0 0 0 0 0 0 1 3308 157 0 0 0 0 0 0 0 0 0 0 0 0 3094 158 1 0 0 0 0 0 0 0 0 0 0 0 3397 159 0 1 0 0 0 0 0 0 0 0 0 0 3424 160 0 0 1 0 0 0 0 0 0 0 0 0 3704 161 0 0 0 1 0 0 0 0 0 0 0 0 3468 162 0 0 0 0 1 0 0 0 0 0 0 0 3636 163 0 0 0 0 0 1 0 0 0 0 0 0 3544 164 0 0 0 0 0 0 1 0 0 0 0 0 3387 165 0 0 0 0 0 0 0 1 0 0 0 0 3330 166 0 0 0 0 0 0 0 0 1 0 0 0 3137 167 0 0 0 0 0 0 0 0 0 1 0 0 3171 168 0 0 0 0 0 0 0 0 0 0 0 1 3529 169 0 0 0 0 0 0 0 0 0 0 0 0 3016 170 1 0 0 0 0 0 0 0 0 0 0 0 3576 171 0 1 0 0 0 0 0 0 0 0 0 0 3526 172 0 0 1 0 0 0 0 0 0 0 0 0 3538 173 0 0 0 1 0 0 0 0 0 0 0 0 3479 174 0 0 0 0 1 0 0 0 0 0 0 0 3640 175 0 0 0 0 0 1 0 0 0 0 0 0 3580 176 0 0 0 0 0 0 1 0 0 0 0 0 3450 177 0 0 0 0 0 0 0 1 0 0 0 0 3467 178 0 0 0 0 0 0 0 0 1 0 0 0 3172 179 0 0 0 0 0 0 0 0 0 1 0 0 3176 180 0 0 0 0 0 0 0 0 0 0 0 1 3320 181 0 0 0 0 0 0 0 0 0 0 0 0 3091 182 1 0 0 0 0 0 0 0 0 0 0 0 3408 183 0 1 0 0 0 0 0 0 0 0 0 0 3606 184 0 0 1 0 0 0 0 0 0 0 0 0 3589 185 0 0 0 1 0 0 0 0 0 0 0 0 3552 186 0 0 0 0 1 0 0 0 0 0 0 0 3534 187 0 0 0 0 0 1 0 0 0 0 0 0 4027 188 0 0 0 0 0 0 1 0 0 0 1 0 4034 189 0 0 0 0 0 0 0 1 0 0 1 0 3791 190 0 0 0 0 0 0 0 0 1 0 0 0 3480 191 0 0 0 0 0 0 0 0 0 1 0 0 3394 192 0 0 0 0 0 0 0 0 0 0 0 1 3618 193 0 0 0 0 0 0 0 0 0 0 0 0 3215 194 1 0 0 0 0 0 0 0 0 0 0 0 3935 195 0 1 0 0 0 0 0 0 0 0 0 0 3726 196 0 0 1 0 0 0 0 0 0 0 0 0 3966 197 0 0 0 1 0 0 0 0 0 0 0 0 3785 198 0 0 0 0 1 0 0 0 0 0 0 0 3944 199 0 0 0 0 0 1 0 0 0 0 0 0 3912 200 0 0 0 0 0 0 1 0 0 0 0 0 3578 201 0 0 0 0 0 0 0 1 0 0 0 0 3688 202 0 0 0 0 0 0 0 0 1 0 0 0 3357 203 0 0 0 0 0 0 0 0 0 1 0 0 3469 204 0 0 0 0 0 0 0 0 0 0 0 1
Names of X columns:
AllSuicides totalmo 2 3 4 5 6 7 8 9 10 11 12 rw
Sample Range:
(leave blank to include all observations)
From:
To:
Column Number of Endogenous Series
(?)
Fixed Seasonal Effects
Do not include Seasonal Dummies
Do not include Seasonal Dummies
Include Seasonal Dummies
Type of Equation
No Linear Trend
No Linear Trend
Linear Trend
First Differences
Seasonal Differences (s)
First and Seasonal Differences (s)
Degree of Predetermination (lagged endogenous variables)
Degree of Seasonal Predetermination
Seasonality
12
12
1
2
3
4
5
6
7
8
9
10
11
12
Chart options
R Code
library(lattice) library(lmtest) library(car) library(MASS) n25 <- 25 #minimum number of obs. for Goldfeld-Quandt test mywarning <- '' par6 <- as.numeric(par6) if(is.na(par6)) { par6 <- 12 mywarning = 'Warning: you did not specify the seasonality. The seasonal period was set to s = 12.' } par1 <- as.numeric(par1) if(is.na(par1)) { par1 <- 1 mywarning = 'Warning: you did not specify the column number of the endogenous series! The first column was selected by default.' } if (par4=='') par4 <- 0 par4 <- as.numeric(par4) if (!is.numeric(par4)) par4 <- 0 if (par5=='') par5 <- 0 par5 <- as.numeric(par5) if (!is.numeric(par5)) par5 <- 0 x <- na.omit(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'){ (n <- n -1) x2 <- array(0, dim=c(n,k), dimnames=list(1:n, paste('(1-B)',colnames(x),sep=''))) for (i in 1:n) { for (j in 1:k) { x2[i,j] <- x[i+1,j] - x[i,j] } } x <- x2 } if (par3 == 'Seasonal Differences (s)'){ (n <- n - par6) x2 <- array(0, dim=c(n,k), dimnames=list(1:n, paste('(1-Bs)',colnames(x),sep=''))) for (i in 1:n) { for (j in 1:k) { x2[i,j] <- x[i+par6,j] - x[i,j] } } x <- x2 } if (par3 == 'First and Seasonal Differences (s)'){ (n <- n -1) x2 <- array(0, dim=c(n,k), dimnames=list(1:n, paste('(1-B)',colnames(x),sep=''))) for (i in 1:n) { for (j in 1:k) { x2[i,j] <- x[i+1,j] - x[i,j] } } x <- x2 (n <- n - par6) x2 <- array(0, dim=c(n,k), dimnames=list(1:n, paste('(1-Bs)',colnames(x),sep=''))) for (i in 1:n) { for (j in 1:k) { x2[i,j] <- x[i+par6,j] - x[i,j] } } x <- x2 } if(par4 > 0) { x2 <- array(0, dim=c(n-par4,par4), dimnames=list(1:(n-par4), paste(colnames(x)[par1],'(t-',1:par4,')',sep=''))) for (i in 1:(n-par4)) { for (j in 1:par4) { x2[i,j] <- x[i+par4-j,par1] } } x <- cbind(x[(par4+1):n,], x2) n <- n - par4 } if(par5 > 0) { x2 <- array(0, dim=c(n-par5*par6,par5), dimnames=list(1:(n-par5*par6), paste(colnames(x)[par1],'(t-',1:par5,'s)',sep=''))) for (i in 1:(n-par5*par6)) { for (j in 1:par5) { x2[i,j] <- x[i+par5*par6-j*par6,par1] } } x <- cbind(x[(par5*par6+1):n,], x2) n <- n - par5*par6 } if (par2 == 'Include Seasonal Dummies'){ x2 <- array(0, dim=c(n,par6-1), dimnames=list(1:n, paste('M', seq(1:(par6-1)), sep =''))) for (i in 1:(par6-1)){ x2[seq(i,n,par6),i] <- 1 } x <- cbind(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[n,])) if (par3 == 'Linear Trend'){ x <- cbind(x, c(1:n)) colnames(x)[k+1] <- 't' } print(x) (k <- length(x[n,])) head(x) 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') sresid <- studres(mylm) hist(sresid, freq=FALSE, main='Distribution of Studentized Residuals') xfit<-seq(min(sresid),max(sresid),length=40) yfit<-dnorm(xfit) lines(xfit, yfit) 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') qqPlot(mylm, main='QQ Plot') 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) print(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, signif(mysum$coefficients[i,1],6), 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.row.start(a) a<-table.element(a, mywarning) 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,'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,formatC(signif(mysum$coefficients[i,1],5),format='g',flag='+')) a<-table.element(a,formatC(signif(mysum$coefficients[i,2],5),format='g',flag=' ')) a<-table.element(a,formatC(signif(mysum$coefficients[i,3],4),format='e',flag='+')) a<-table.element(a,formatC(signif(mysum$coefficients[i,4],4),format='g',flag=' ')) a<-table.element(a,formatC(signif(mysum$coefficients[i,4]/2,4),format='g',flag=' ')) 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,formatC(signif(sqrt(mysum$r.squared),6),format='g',flag=' ')) a<-table.row.end(a) a<-table.row.start(a) a<-table.element(a, 'R-squared',1,TRUE) a<-table.element(a,formatC(signif(mysum$r.squared,6),format='g',flag=' ')) a<-table.row.end(a) a<-table.row.start(a) a<-table.element(a, 'Adjusted R-squared',1,TRUE) a<-table.element(a,formatC(signif(mysum$adj.r.squared,6),format='g',flag=' ')) a<-table.row.end(a) a<-table.row.start(a) a<-table.element(a, 'F-TEST (value)',1,TRUE) a<-table.element(a,formatC(signif(mysum$fstatistic[1],6),format='g',flag=' ')) a<-table.row.end(a) a<-table.row.start(a) a<-table.element(a, 'F-TEST (DF numerator)',1,TRUE) a<-table.element(a, signif(mysum$fstatistic[2],6)) a<-table.row.end(a) a<-table.row.start(a) a<-table.element(a, 'F-TEST (DF denominator)',1,TRUE) a<-table.element(a, signif(mysum$fstatistic[3],6)) a<-table.row.end(a) a<-table.row.start(a) a<-table.element(a, 'p-value',1,TRUE) a<-table.element(a,formatC(signif(1-pf(mysum$fstatistic[1],mysum$fstatistic[2],mysum$fstatistic[3]),6),format='g',flag=' ')) 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,formatC(signif(mysum$sigma,6),format='g',flag=' ')) a<-table.row.end(a) a<-table.row.start(a) a<-table.element(a, 'Sum Squared Residuals',1,TRUE) a<-table.element(a,formatC(signif(sum(myerror*myerror),6),format='g',flag=' ')) a<-table.row.end(a) a<-table.end(a) table.save(a,file='mytable3.tab') myr <- as.numeric(mysum$resid) myr a <-table.start() a <- table.row.start(a) a <- table.element(a,'Menu of Residual Diagnostics',2,TRUE) a <- table.row.end(a) a <- table.row.start(a) a <- table.element(a,'Description',1,TRUE) a <- table.element(a,'Link',1,TRUE) a <- table.row.end(a) a <- table.row.start(a) a <-table.element(a,'Histogram',1,header=TRUE) a <- table.element(a,hyperlink( paste('https://supernova.wessa.net/rwasp_histogram.wasp?convertgetintopost=1&data=',paste(as.character(mysum$resid),sep='',collapse=' '),sep='') ,'Compute','Click here to examine the Residuals.'),1) a <- table.row.end(a) a <- table.row.start(a) a <-table.element(a,'Central Tendency',1,header=TRUE) a <- table.element(a,hyperlink( paste('https://supernova.wessa.net/rwasp_centraltendency.wasp?convertgetintopost=1&data=',paste(as.character(mysum$resid),sep='',collapse=' '),sep='') ,'Compute','Click here to examine the Residuals.'),1) a <- table.row.end(a) a <- table.row.start(a) a <-table.element(a,'QQ Plot',1,header=TRUE) a <- table.element(a,hyperlink( paste('https://supernova.wessa.net/rwasp_fitdistrnorm.wasp?convertgetintopost=1&data=',paste(as.character(mysum$resid),sep='',collapse=' '),sep='') ,'Compute','Click here to examine the Residuals.'),1) a <- table.row.end(a) a <- table.row.start(a) a <-table.element(a,'Kernel Density Plot',1,header=TRUE) a <- table.element(a,hyperlink( paste('https://supernova.wessa.net/rwasp_density.wasp?convertgetintopost=1&data=',paste(as.character(mysum$resid),sep='',collapse=' '),sep='') ,'Compute','Click here to examine the Residuals.'),1) a <- table.row.end(a) a <- table.row.start(a) a <-table.element(a,'Skewness/Kurtosis Test',1,header=TRUE) a <- table.element(a,hyperlink( paste('https://supernova.wessa.net/rwasp_skewness_kurtosis.wasp?convertgetintopost=1&data=',paste(as.character(mysum$resid),sep='',collapse=' '),sep='') ,'Compute','Click here to examine the Residuals.'),1) a <- table.row.end(a) a <- table.row.start(a) a <-table.element(a,'Skewness-Kurtosis Plot',1,header=TRUE) a <- table.element(a,hyperlink( paste('https://supernova.wessa.net/rwasp_skewness_kurtosis_plot.wasp?convertgetintopost=1&data=',paste(as.character(mysum$resid),sep='',collapse=' '),sep='') ,'Compute','Click here to examine the Residuals.'),1) a <- table.row.end(a) a <- table.row.start(a) a <-table.element(a,'Harrell-Davis Plot',1,header=TRUE) a <- table.element(a,hyperlink( paste('https://supernova.wessa.net/rwasp_harrell_davis.wasp?convertgetintopost=1&data=',paste(as.character(mysum$resid),sep='',collapse=' '),sep='') ,'Compute','Click here to examine the Residuals.'),1) a <- table.row.end(a) a <- table.row.start(a) a <-table.element(a,'Bootstrap Plot -- Central Tendency',1,header=TRUE) a <- table.element(a,hyperlink( paste('https://supernova.wessa.net/rwasp_bootstrapplot1.wasp?convertgetintopost=1&data=',paste(as.character(mysum$resid),sep='',collapse=' '),sep='') ,'Compute','Click here to examine the Residuals.'),1) a <- table.row.end(a) a <- table.row.start(a) a <-table.element(a,'Blocked Bootstrap Plot -- Central Tendency',1,header=TRUE) a <- table.element(a,hyperlink( paste('https://supernova.wessa.net/rwasp_bootstrapplot.wasp?convertgetintopost=1&data=',paste(as.character(mysum$resid),sep='',collapse=' '),sep='') ,'Compute','Click here to examine the Residuals.'),1) a <- table.row.end(a) a <- table.row.start(a) a <-table.element(a,'(Partial) Autocorrelation Plot',1,header=TRUE) a <- table.element(a,hyperlink( paste('https://supernova.wessa.net/rwasp_autocorrelation.wasp?convertgetintopost=1&data=',paste(as.character(mysum$resid),sep='',collapse=' '),sep='') ,'Compute','Click here to examine the Residuals.'),1) a <- table.row.end(a) a <- table.row.start(a) a <-table.element(a,'Spectral Analysis',1,header=TRUE) a <- table.element(a,hyperlink( paste('https://supernova.wessa.net/rwasp_spectrum.wasp?convertgetintopost=1&data=',paste(as.character(mysum$resid),sep='',collapse=' '),sep='') ,'Compute','Click here to examine the Residuals.'),1) a <- table.row.end(a) a <- table.row.start(a) a <-table.element(a,'Tukey lambda PPCC Plot',1,header=TRUE) a <- table.element(a,hyperlink( paste('https://supernova.wessa.net/rwasp_tukeylambda.wasp?convertgetintopost=1&data=',paste(as.character(mysum$resid),sep='',collapse=' '),sep='') ,'Compute','Click here to examine the Residuals.'),1) a <- table.row.end(a) a <- table.row.start(a) a <-table.element(a,'Box-Cox Normality Plot',1,header=TRUE) a <- table.element(a,hyperlink( paste('https://supernova.wessa.net/rwasp_boxcoxnorm.wasp?convertgetintopost=1&data=',paste(as.character(mysum$resid),sep='',collapse=' '),sep='') ,'Compute','Click here to examine the Residuals.'),1) a <- table.row.end(a) a <- table.row.start(a) a <- table.element(a,'Summary Statistics',1,header=TRUE) a <- table.element(a,hyperlink( paste('https://supernova.wessa.net/rwasp_summary1.wasp?convertgetintopost=1&data=',paste(as.character(mysum$resid),sep='',collapse=' '),sep='') ,'Compute','Click here to examine the Residuals.'),1) a <- table.row.end(a) a<-table.end(a) table.save(a,file='mytable7.tab') if(n < 200) { 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,formatC(signif(x[i],6),format='g',flag=' ')) a<-table.element(a,formatC(signif(x[i]-mysum$resid[i],6),format='g',flag=' ')) a<-table.element(a,formatC(signif(mysum$resid[i],6),format='g',flag=' ')) 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,formatC(signif(gqarr[mypoint-kp3+1,1],6),format='g',flag=' ')) a<-table.element(a,formatC(signif(gqarr[mypoint-kp3+1,2],6),format='g',flag=' ')) a<-table.element(a,formatC(signif(gqarr[mypoint-kp3+1,3],6),format='g',flag=' ')) 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,signif(numsignificant1,6)) a<-table.element(a,formatC(signif(numsignificant1/numgqtests,6),format='g',flag=' ')) 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,signif(numsignificant5,6)) a<-table.element(a,signif(numsignificant5/numgqtests,6)) 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,signif(numsignificant10,6)) a<-table.element(a,signif(numsignificant10/numgqtests,6)) 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') } } a<-table.start() a<-table.row.start(a) a<-table.element(a,'Ramsey RESET F-Test for powers (2 and 3) of fitted values',1,TRUE) a<-table.row.end(a) a<-table.row.start(a) reset_test_fitted <- resettest(mylm,power=2:3,type='fitted') a<-table.element(a,paste('<pre>',RC.texteval('reset_test_fitted'),'</pre>',sep='')) a<-table.row.end(a) a<-table.row.start(a) a<-table.element(a,'Ramsey RESET F-Test for powers (2 and 3) of regressors',1,TRUE) a<-table.row.end(a) a<-table.row.start(a) reset_test_regressors <- resettest(mylm,power=2:3,type='regressor') a<-table.element(a,paste('<pre>',RC.texteval('reset_test_regressors'),'</pre>',sep='')) a<-table.row.end(a) a<-table.row.start(a) a<-table.element(a,'Ramsey RESET F-Test for powers (2 and 3) of principal components',1,TRUE) a<-table.row.end(a) a<-table.row.start(a) reset_test_principal_components <- resettest(mylm,power=2:3,type='princomp') a<-table.element(a,paste('<pre>',RC.texteval('reset_test_principal_components'),'</pre>',sep='')) a<-table.row.end(a) a<-table.end(a) table.save(a,file='mytable8.tab') a<-table.start() a<-table.row.start(a) a<-table.element(a,'Variance Inflation Factors (Multicollinearity)',1,TRUE) a<-table.row.end(a) a<-table.row.start(a) vif <- vif(mylm) a<-table.element(a,paste('<pre>',RC.texteval('vif'),'</pre>',sep='')) a<-table.row.end(a) a<-table.end(a) table.save(a,file='mytable9.tab')
Compute
Summary of computational transaction
Raw Input
view raw input (R code)
Raw Output
view raw output of R engine
Computing time
1 seconds
R Server
Big Analytics Cloud Computing Center
Click here to blog (archive) this computation