Send output to:
Browser Blue - Charts White
Browser Black/White
CSV
Data X:
1769 240 118 151036 26258 810 111 55 92556 14881 919 91 67 57803 16957 769 68 60 68701 18717 712 57 39 41152 8464 760 61 82 92596 26641 664 77 55 35728 9724 1118 129 76 54002 20323 624 217 55 62897 22557 694 104 45 57021 14612 861 117 76 58092 4362 910 108 53 29245 6372 975 99 75 47007 13448 742 48 54 42009 14349 890 58 46 36022 10881 697 90 78 83700 20517 651 87 63 46456 13275 456 60 50 38844 8030 815 40 52 40078 16318 726 95 26 46609 11252 526 61 95 73116 11219 483 67 68 74990 19365 628 67 73 49598 14426 597 68 35 40400 2570 584 54 53 29010 9863 616 149 58 58534 15657 588 80 43 66616 21224 611 64 71 52143 20488 426 52 45 33629 10265 880 86 30 57476 7768 496 42 54 31076 10462 734 74 54 63369 5989 562 85 48 20465 6200 297 77 67 44663 15329 301 38 35 27525 10698 606 56 48 57786 6837 474 65 67 41211 9188 427 41 50 34711 9556 384 54 62 31172 8247 407 56 39 37477 7028 395 32 25 23284 5753 535 92 26 28549 6852 875 55 62 41554 10615 771 71 40 29351 9289 452 77 54 59147 6185 627 60 67 92901 12964 496 46 32 48140 8895 569 80 50 36205 5299 497 37 48 44810 9435 375 49 45 28735 5389 756 89 59 75043 9970 282 85 40 37403 13958 513 25 39 30165 7233 587 69 66 76542 13178 539 75 68 66856 14884 518 48 30 40715 7820 498 53 42 33287 10165 391 52 75 78950 24369 449 52 33 100674 7642 454 52 50 33277 13823 495 45 35 53349 13073 843 65 83 29653 9422 538 54 64 34241 11580 597 53 31 44093 15604 471 49 46 26757 9831 298 42 78 33994 12840 466 57 27 53216 6616 405 41 49 31032 7987 721 82 54 46154 17327 618 91 49 25629 8874 629 71 50 49830 8058 468 41 48 28113 8683 661 95 53 74608 7192 273 47 47 39644 13400 465 50 35 23110 8374 360 44 51 32665 8208 535 37 45 65897 12112 347 56 43 61281 10170 381 61 67 30874 12396 287 37 36 38610 6873 315 59 47 35139 14146 497 49 55 41194 4260 372 56 52 32683 10566 341 26 23 22527 5953 366 65 25 37941 5322 352 61 36 50008 5413 248 36 48 64622 12310 384 33 44 25820 7573 673 71 36 31141 7230 442 65 46 13310 3394 312 43 25 28470 8191 560 49 38 33797 5162 438 32 37 28263 10226 322 42 44 60132 11270 410 62 62 52338 10837 391 37 38 35378 9791 249 53 24 19249 7488 350 29 25 84205 9184 386 18 17 23494 8181 483 49 44 23333 8022 360 54 39 41622 8620 229 31 12 13018 1350 241 39 30 22698 5141 574 94 41 21055 7945 306 31 46 98177 10623 395 71 34 42249 10138 248 36 21 61849 1661 244 95 42 22883 6900 212 31 23 24460 7162 211 64 54 42005 14697 190 37 30 15292 4574 251 22 25 27084 7509 345 37 2 10956 3495 287 57 36 34545 1900 305 52 0 13497 70 247 23 15 8019 3080 165 39 3 32689 443 253 23 16 21152 4911 240 20 41 31747 6562 244 26 26 14399 4204 310 52 16 10726 3149 263 27 13 2325 593 256 42 17 17215 3456 291 34 22 40911 9570 205 28 12 22346 2102 292 19 7 2781 4 183 16 8 5444 775 101 15 5 4157 1283 215 24 13 53249 3878 194 22 2 5842 522 75 12 10 5752 2416 67 12 13 3895 786 79 9 1 0 0 33 9 0 0 0 97 13 0 2179 548 72 18 0 1423 603 27 4 0 0 0 11 3 0 0 0 6 3 5 0 0 14 5 0 0 0 0 1 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
quantiles
hclust
equal
Number of categories (only if categorization<>none)
Cross-Validation? (only if categorization<>none)
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