Send output to:
Browser Blue - Charts White
Browser Black/White
CSV
Data X:
129988 81 18158 22622 130358 46 30461 73570 7215 18 1423 1929 112976 87 25629 36294 220191 127 48758 62378 402036 218 129230 167760 125071 51 27376 52443 131822 50 26706 57283 99738 39 26505 36614 269166 88 49801 93268 113066 69 46580 35439 165392 62 48352 72405 78240 90 13899 24044 170854 86 39342 55909 134368 47 27465 44689 125769 68 55211 49319 123467 50 74098 62075 57396 49 13497 2341 108458 79 38338 40551 22762 21 52505 11621 48633 50 10663 18741 182081 83 74484 84202 149507 62 28895 15334 93773 46 32827 28024 133428 79 36188 53306 126660 24 28173 37918 153851 140 54926 54819 140711 75 38900 89058 303952 108 88530 103354 163810 38 35482 70239 134521 41 26730 33045 157640 39 29806 63852 103274 90 41799 30905 193500 105 54289 24242 182027 44 36805 78907 0 1 0 0 181496 56 33146 36005 92342 47 23333 31972 115762 42 47686 35853 179089 51 77783 115301 145067 58 36042 47689 114146 50 34541 34223 86039 26 75620 43431 125481 66 60610 52220 95535 42 55041 33863 129236 79 32087 46879 61554 26 16356 23228 170811 83 40161 42827 161746 76 55459 65765 137317 52 36679 38167 48188 28 22346 14812 97793 57 27377 32615 249356 65 50273 82188 196791 69 32104 51763 161082 51 27016 59325 111388 47 19715 48976 172614 58 33629 43384 63681 19 27084 26692 109102 56 32352 53279 142391 76 51845 20652 125777 51 26591 38338 88650 66 29677 36735 95845 50 54237 42764 83419 29 20284 44331 101723 25 22741 41354 94982 37 34178 47879 145568 62 69551 103793 113325 63 29653 52235 92480 34 38071 49825 31970 15 4157 4105 196420 104 28321 58687 98324 56 40195 40745 80820 56 48158 33187 89319 61 13310 14063 118147 55 78474 37407 56544 32 6386 7190 118838 52 31588 49562 118781 80 61254 76324 60138 23 21152 21928 73422 66 41272 27860 70248 60 34165 28078 225857 54 37054 49577 51185 24 12368 28145 97181 32 23168 36241 45100 40 16380 10824 115801 43 41242 46892 187201 191 48450 61264 71960 86 20790 22933 81701 49 34585 20787 110416 43 35672 43978 98707 34 52168 51305 136234 67 53933 55593 136781 53 34474 51648 116132 54 43753 30552 49164 33 36456 23470 189493 93 51183 77530 169406 50 52742 57299 19349 12 3895 9604 160902 88 37076 34684 109510 53 24079 41094 43803 25 2325 3439 47062 19 29354 25171 110845 44 30341 23437 92517 52 18992 34086 58660 36 15292 24649 27676 22 5842 2342 98550 33 28918 45571 43863 25 3738 3255 0 0 0 0 75566 28 95352 30002 57359 49 37478 19360 104330 36 26839 43320 70369 47 26783 35513 65494 56 33392 23536 3616 5 0 0 0 0 0 0 148117 38 25446 54438 117946 66 59847 56812 138702 86 28162 33838 84336 33 33298 32366 43410 19 2781 13 139695 61 37121 55082 79015 34 22698 31334 106116 47 27615 16612 57586 38 32689 5084 19764 12 5752 9927 112195 43 23164 47413 103651 25 20304 27389 113402 35 34409 30425 11796 9 0 0 7627 9 0 0 121085 50 92538 33510 6836 3 0 0 139563 46 46037 40389 5118 3 0 0 40248 16 5444 6012 0 0 0 0 95079 42 23924 22205 80763 32 52230 17231 7131 4 0 0 4194 11 0 0 60378 20 8019 11017 109214 45 34542 46741 83484 16 21157 39869
Names of X columns:
A B C D
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