Send output to:
Browser Blue - Charts White
Browser Black/White
CSV
Data X:
240 36 278 151036 26258 111 28 84 92556 14881 91 26 129 57803 16957 68 27 89 68701 18717 57 29 60 41152 8464 61 31 60 92596 26641 77 26 67 35728 9724 129 30 124 54002 20323 217 33 100 62897 22557 104 36 166 57021 14612 117 25 302 58092 4362 108 19 135 29245 6372 99 25 255 47007 13448 48 24 84 42009 14349 58 27 58 36022 10881 90 27 94 83700 20517 87 21 114 46456 13275 60 26 58 38844 8030 40 20 90 40078 16318 95 24 104 46609 11252 61 24 94 73116 11219 67 36 86 74990 19365 67 21 94 49598 14426 68 25 127 40400 2570 54 33 49 29010 9863 149 25 90 58534 15657 80 31 113 66616 21224 64 30 113 52143 20488 52 20 74 33629 10265 86 38 59 57476 7768 42 20 111 31076 10462 74 24 59 63369 5989 85 18 109 20465 6200 77 28 55 44663 15329 38 23 70 27525 10698 56 21 48 57786 6837 65 25 88 41211 9188 41 28 76 34711 9556 54 30 54 31172 8247 56 25 68 37477 7028 32 26 56 23284 5753 92 28 119 28549 6852 55 26 171 41554 10615 71 31 61 29351 9289 77 19 81 59147 6185 60 34 89 92901 12964 46 26 71 48140 8895 80 21 41 36205 5299 37 29 97 44810 9435 49 17 50 28735 5389 89 28 69 75043 9970 85 22 40 37403 13958 25 21 160 30165 7233 69 23 87 76542 13178 75 29 72 66856 14884 48 21 72 40715 7820 53 23 89 33287 10165 52 33 92 78950 24369 52 18 37 100674 7642 52 29 65 33277 13823 45 32 267 53349 13073 65 25 152 29653 9422 54 27 111 34241 11580 53 34 62 44093 15604 49 20 61 26757 9831 42 29 127 33994 12840 57 15 81 53216 6616 41 23 55 31032 7987 82 34 142 46154 17327 91 26 154 25629 8874 72 24 158 49830 8058 41 30 87 28113 8683 95 17 87 74608 7192 47 21 54 39644 13400 50 11 74 23110 8374 44 23 84 32665 8208 37 28 59 65897 12112 56 19 84 61281 10170 61 21 51 30874 12396 37 23 56 38610 6873 59 23 32 35139 14146 49 29 60 41194 4260 56 21 65 32683 10566 26 25 66 22527 5953 65 21 57 37941 5322 61 12 80 50008 5413 36 24 48 64622 12310 33 24 46 25820 7573 71 19 81 31141 7230 65 21 89 13310 3394 43 25 49 28470 8191 49 34 164 33797 5162 32 25 132 28263 10226 42 22 46 60132 11270 62 28 60 52338 10837 37 29 36 35378 9791 53 23 66 19249 7488 29 23 35 84205 9184 18 22 50 23494 8181 49 14 137 23333 8022 54 24 49 41622 8620 31 10 32 13018 1350 39 17 46 22698 5141 94 21 83 21055 7945 31 25 58 98177 10623 71 31 105 42249 10138 36 26 44 61849 1661 95 22 71 22883 6900 31 35 49 24460 7162 64 26 49 42005 14697 37 12 27 15292 4574 22 26 72 27084 7509 37 32 79 10956 3495 57 21 71 34545 1900 52 15 72 13497 70 23 17 48 8019 3080 39 12 29 32689 443 23 21 76 21152 4911 20 20 44 31747 6562 26 23 49 14399 4204 52 15 40 10726 3149 27 4 11 2325 593 42 22 49 17215 3456 34 13 30 40911 9570 28 22 37 22346 2102 19 1 63 2781 4 16 4 34 5444 775 15 21 40 4157 1283 24 18 49 53249 3878 22 16 59 5842 522 12 2 19 5752 2416 12 1 15 3895 786 9 2 22 0 0 9 0 7 0 0 13 4 18 2179 548 18 0 1 1423 603 4 0 0 0 0 3 1 5 0 0 3 0 1 0 0 5 0 5 0 0 1 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0
Names of X columns:
X1 X2 X3 X4 X5
Endogenous Variable (Column Number)
Categorization
none
none
quantiles
hclust
equal
Number of categories (only if categorization<>none)
Cross-Validation? (only if categorization<>none)
no
no
yes
Chart options
R Code
library(party) library(Hmisc) par1 <- as.numeric(par1) par3 <- as.numeric(par3) x <- data.frame(t(y)) is.data.frame(x) x <- x[!is.na(x[,par1]),] k <- length(x[1,]) n <- length(x[,1]) colnames(x)[par1] x[,par1] if (par2 == 'kmeans') { cl <- kmeans(x[,par1], par3) print(cl) clm <- matrix(cbind(cl$centers,1:par3),ncol=2) clm <- clm[sort.list(clm[,1]),] for (i in 1:par3) { cl$cluster[cl$cluster==clm[i,2]] <- paste('C',i,sep='') } cl$cluster <- as.factor(cl$cluster) print(cl$cluster) x[,par1] <- cl$cluster } if (par2 == 'quantiles') { x[,par1] <- cut2(x[,par1],g=par3) } if (par2 == 'hclust') { hc <- hclust(dist(x[,par1])^2, 'cen') print(hc) memb <- cutree(hc, k = par3) dum <- c(mean(x[memb==1,par1])) for (i in 2:par3) { dum <- c(dum, mean(x[memb==i,par1])) } hcm <- matrix(cbind(dum,1:par3),ncol=2) hcm <- hcm[sort.list(hcm[,1]),] for (i in 1:par3) { memb[memb==hcm[i,2]] <- paste('C',i,sep='') } memb <- as.factor(memb) print(memb) x[,par1] <- memb } if (par2=='equal') { ed <- cut(as.numeric(x[,par1]),par3,labels=paste('C',1:par3,sep='')) x[,par1] <- as.factor(ed) } table(x[,par1]) colnames(x) colnames(x)[par1] x[,par1] if (par2 == 'none') { m <- ctree(as.formula(paste(colnames(x)[par1],' ~ .',sep='')),data = x) } load(file='createtable') if (par2 != 'none') { m <- ctree(as.formula(paste('as.factor(',colnames(x)[par1],') ~ .',sep='')),data = x) if (par4=='yes') { a<-table.start() a<-table.row.start(a) a<-table.element(a,'10-Fold Cross Validation',3+2*par3,TRUE) a<-table.row.end(a) a<-table.row.start(a) a<-table.element(a,'',1,TRUE) a<-table.element(a,'Prediction (training)',par3+1,TRUE) a<-table.element(a,'Prediction (testing)',par3+1,TRUE) a<-table.row.end(a) a<-table.row.start(a) a<-table.element(a,'Actual',1,TRUE) for (jjj in 1:par3) a<-table.element(a,paste('C',jjj,sep=''),1,TRUE) a<-table.element(a,'CV',1,TRUE) for (jjj in 1:par3) a<-table.element(a,paste('C',jjj,sep=''),1,TRUE) a<-table.element(a,'CV',1,TRUE) a<-table.row.end(a) for (i in 1:10) { ind <- sample(2, nrow(x), replace=T, prob=c(0.9,0.1)) m.ct <- ctree(as.formula(paste('as.factor(',colnames(x)[par1],') ~ .',sep='')),data =x[ind==1,]) if (i==1) { m.ct.i.pred <- predict(m.ct, newdata=x[ind==1,]) m.ct.i.actu <- x[ind==1,par1] m.ct.x.pred <- predict(m.ct, newdata=x[ind==2,]) m.ct.x.actu <- x[ind==2,par1] } else { m.ct.i.pred <- c(m.ct.i.pred,predict(m.ct, newdata=x[ind==1,])) m.ct.i.actu <- c(m.ct.i.actu,x[ind==1,par1]) m.ct.x.pred <- c(m.ct.x.pred,predict(m.ct, newdata=x[ind==2,])) m.ct.x.actu <- c(m.ct.x.actu,x[ind==2,par1]) } } print(m.ct.i.tab <- table(m.ct.i.actu,m.ct.i.pred)) numer <- 0 for (i in 1:par3) { print(m.ct.i.tab[i,i] / sum(m.ct.i.tab[i,])) numer <- numer + m.ct.i.tab[i,i] } print(m.ct.i.cp <- numer / sum(m.ct.i.tab)) print(m.ct.x.tab <- table(m.ct.x.actu,m.ct.x.pred)) numer <- 0 for (i in 1:par3) { print(m.ct.x.tab[i,i] / sum(m.ct.x.tab[i,])) numer <- numer + m.ct.x.tab[i,i] } print(m.ct.x.cp <- numer / sum(m.ct.x.tab)) for (i in 1:par3) { a<-table.row.start(a) a<-table.element(a,paste('C',i,sep=''),1,TRUE) for (jjj in 1:par3) a<-table.element(a,m.ct.i.tab[i,jjj]) a<-table.element(a,round(m.ct.i.tab[i,i]/sum(m.ct.i.tab[i,]),4)) for (jjj in 1:par3) a<-table.element(a,m.ct.x.tab[i,jjj]) a<-table.element(a,round(m.ct.x.tab[i,i]/sum(m.ct.x.tab[i,]),4)) a<-table.row.end(a) } a<-table.row.start(a) a<-table.element(a,'Overall',1,TRUE) for (jjj in 1:par3) a<-table.element(a,'-') a<-table.element(a,round(m.ct.i.cp,4)) for (jjj in 1:par3) a<-table.element(a,'-') a<-table.element(a,round(m.ct.x.cp,4)) a<-table.row.end(a) a<-table.end(a) table.save(a,file='mytable3.tab') } } m bitmap(file='test1.png') plot(m) dev.off() bitmap(file='test1a.png') plot(x[,par1] ~ as.factor(where(m)),main='Response by Terminal Node',xlab='Terminal Node',ylab='Response') dev.off() if (par2 == 'none') { forec <- predict(m) result <- as.data.frame(cbind(x[,par1],forec,x[,par1]-forec)) colnames(result) <- c('Actuals','Forecasts','Residuals') print(result) } if (par2 != 'none') { print(cbind(as.factor(x[,par1]),predict(m))) myt <- table(as.factor(x[,par1]),predict(m)) print(myt) } bitmap(file='test2.png') if(par2=='none') { op <- par(mfrow=c(2,2)) plot(density(result$Actuals),main='Kernel Density Plot of Actuals') plot(density(result$Residuals),main='Kernel Density Plot of Residuals') plot(result$Forecasts,result$Actuals,main='Actuals versus Predictions',xlab='Predictions',ylab='Actuals') plot(density(result$Forecasts),main='Kernel Density Plot of Predictions') par(op) } if(par2!='none') { plot(myt,main='Confusion Matrix',xlab='Actual',ylab='Predicted') } dev.off() if (par2 == 'none') { detcoef <- cor(result$Forecasts,result$Actuals) a<-table.start() a<-table.row.start(a) a<-table.element(a,'Goodness of Fit',2,TRUE) a<-table.row.end(a) a<-table.row.start(a) a<-table.element(a,'Correlation',1,TRUE) a<-table.element(a,round(detcoef,4)) a<-table.row.end(a) a<-table.row.start(a) a<-table.element(a,'R-squared',1,TRUE) a<-table.element(a,round(detcoef*detcoef,4)) a<-table.row.end(a) a<-table.row.start(a) a<-table.element(a,'RMSE',1,TRUE) a<-table.element(a,round(sqrt(mean((result$Residuals)^2)),4)) 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,'Actuals, Predictions, and Residuals',4,TRUE) a<-table.row.end(a) a<-table.row.start(a) a<-table.element(a,'#',header=TRUE) a<-table.element(a,'Actuals',header=TRUE) a<-table.element(a,'Forecasts',header=TRUE) a<-table.element(a,'Residuals',header=TRUE) a<-table.row.end(a) for (i in 1:length(result$Actuals)) { a<-table.row.start(a) a<-table.element(a,i,header=TRUE) a<-table.element(a,result$Actuals[i]) a<-table.element(a,result$Forecasts[i]) a<-table.element(a,result$Residuals[i]) a<-table.row.end(a) } a<-table.end(a) table.save(a,file='mytable.tab') } if (par2 != 'none') { a<-table.start() a<-table.row.start(a) a<-table.element(a,'Confusion Matrix (predicted in columns / actuals in rows)',par3+1,TRUE) a<-table.row.end(a) a<-table.row.start(a) a<-table.element(a,'',1,TRUE) for (i in 1:par3) { a<-table.element(a,paste('C',i,sep=''),1,TRUE) } a<-table.row.end(a) for (i in 1:par3) { a<-table.row.start(a) a<-table.element(a,paste('C',i,sep=''),1,TRUE) for (j in 1:par3) { a<-table.element(a,myt[i,j]) } a<-table.row.end(a) } a<-table.end(a) table.save(a,file='mytable2.tab') }
Compute
Summary of computational transaction
Raw Input
view raw input (R code)
Raw Output
view raw output of R engine
Computing time
2 seconds
R Server
Big Analytics Cloud Computing Center
Click here to blog (archive) this computation